From 8ad42717f46313b4e448a6f69e12051d10298f9d Mon Sep 17 00:00:00 2001 From: Martin Kavalar Date: Wed, 4 Nov 2026 12:07:52 +0100 Subject: [PATCH 1/3] feat: run actions in order against the render they were made on Actions now go through a custom Datastar action, @hyperAction(id, params), instead of one @post per action. Each call numbers the action and queues it with the page's signals and the render version of the HTML it was made on; every request posts the tab's actions whose requests have not completed. The server runs a tab's requests one at a time and skips sequence numbers it has already run, so each action runs once and in the order it was made, whichever request arrives first. Each render that changes the HTML gets a version, sent as data-hyper-render-version on #hyper-app (or on a reactive region's root for a partial render), and its actions are kept under it. Positional action ids are resolved against that render, so a click from an outdated page runs the action it showed rather than whatever now sits at its position. A render of the same HTML keeps its version; renders before the page version the client shows are dropped. --- src/hyper/actions.clj | 123 ++++++++++++--- src/hyper/context.clj | 8 + src/hyper/core.clj | 3 +- src/hyper/render.clj | 9 +- src/hyper/server.clj | 259 ++++++++++++++++++++++++------- src/hyper/subview.clj | 20 ++- test/hyper/action_queue_test.clj | 111 +++++++++++++ test/hyper/async_test.clj | 2 +- test/hyper/core_test.clj | 137 +++++----------- test/hyper/expr_test.clj | 8 +- test/hyper/jetty_sse_test.clj | 10 +- test/hyper/test_test.clj | 2 +- test/hyper/upload_test.clj | 4 +- 13 files changed, 502 insertions(+), 194 deletions(-) create mode 100644 test/hyper/action_queue_test.clj diff --git a/src/hyper/actions.clj b/src/hyper/actions.clj index 2aacaba..2364b00 100644 --- a/src/hyper/actions.clj +++ b/src/hyper/actions.clj @@ -36,25 +36,23 @@ "Client-param symbols like $key/$value work inside h/expr.")})) (defn build-action-expr - "Build the Datastar/JS expression string for an action. - Always uses Datastar's @post() so that all non-underscore signals are - automatically sent in the request body. When client params are present, - they are URL-encoded into the query string via the hyper.encodeClientParams helper - so the server can read them from query-params. - Optionally injects a custom Datastar expression to conditionally prevent the post. - base-path is prepended to the /hyper/actions endpoint (empty string when not set)." - [action-id used-params js base-path] + "Build the Datastar/JS expression string for an action: hyper's + `@hyperAction(id, clientParams)` (see `hyper.server/action-script`), which + queues the action with the page's signals, the render it was made on and + the next sequence number, and posts the tab's queued actions so the + server runs each once, in the order they were made. + Optionally injects a custom Datastar expression to conditionally prevent + the action. base-path is unused: the client script knows the endpoint." + [action-id used-params js _base-path] (let [js-injection (when js (str js " && "))] (if (empty? used-params) - (str js-injection "@post('" base-path "/hyper/actions?action-id=" action-id "')") + (str js-injection "@hyperAction('" action-id "')") (let [obj-entries (->> used-params vals (map (fn [{:keys [js key]}] (str key ":" js))) (str/join ","))] - (str js-injection - "@post('" base-path "/hyper/actions?action-id=" action-id - "&' + hyper.encodeClientParams({" obj-entries "}))"))))) + (str js-injection "@hyperAction('" action-id "', {" obj-entries "})"))))) (defn register-action! "Register an action function and return its ID. @@ -72,19 +70,98 @@ ([app-state* session-id tab-id action-fn action-id] (register-action! app-state* session-id tab-id action-fn action-id nil)) ([app-state* session-id tab-id action-fn action-id opts] - (swap! app-state* (fn [state] - (-> state - (assoc-in [:actions action-id] - (cond-> {:fn action-fn - :session-id session-id - :tab-id tab-id} - (:as opts) (assoc :as (:as opts)))) - (update-in [:actions-by-tab tab-id] - (fnil conj #{}) action-id)))) - (when-let [acc context/*registered-action-ids*] - (swap! acc conj action-id)) + (let [action-data (cond-> {:fn action-fn + :session-id session-id + :tab-id tab-id} + (:as opts) (assoc :as (:as opts)))] + (swap! app-state* (fn [state] + (-> state + (assoc-in [:actions action-id] action-data) + (update-in [:actions-by-tab tab-id] + (fnil conj #{}) action-id)))) + (when-let [acc context/*registered-action-ids*] + (swap! acc conj action-id)) + (when-let [acc context/*rendered-actions*] + (swap! acc assoc action-id action-data))) action-id)) +;; --------------------------------------------------------------------------- +;; Render versions +;; --------------------------------------------------------------------------- +;; Action ids count the actions in a render, so the same id means different +;; actions in different renders. Each render that changes the page gets a +;; version, sent with the HTML (`data-hyper-render-version` on #hyper-app, or +;; on a reactive region's root for a partial render), and its actions are +;; kept under it. A click names the version of the HTML it was made on, so +;; it runs the action that HTML showed. +;; +;; Kept under [:tabs tab-id :renders]: +;; :versions {version {:actions {action-id action-data}}} +;; :last-version the latest version handed out +;; :page {:html html :version v} of the latest full render +;; :regions {region-id {:html html :version v}} of the latest partial renders + +(def max-renders-per-tab + "The most render versions kept per tab; beyond it the oldest are dropped." + 64) + +(defn- trim-versions [{:keys [versions page] :as renders}] + (if (<= (count versions) max-renders-per-tab) + renders + (let [drop (->> (keys versions) + (remove #{(:version page)}) + sort + (take (- (count versions) max-renders-per-tab)))] + (update renders :versions #(apply dissoc % drop))))) + +(defn record-render! + "Store the `actions` a render registered under its version and return the + version: the version of the previous render of the same place (`region`, or + the page when nil) when it produced the same `html`, else a new one." + [app-state* tab-id {:keys [region html actions]}] + (let [k (if region [:regions region] [:page]) + state (swap! app-state* + (fn [state] + (if-not (contains? (:tabs state) tab-id) + state + (update-in state [:tabs tab-id :renders] + (fn [renders] + (let [{last-html :html last-v :version} (get-in renders k) + same? (and (= html last-html) + (contains? (:versions renders) last-v)) + v (if same? last-v (inc (:last-version renders 0)))] + (-> renders + (assoc :last-version (max v (:last-version renders 0))) + (assoc-in [:versions v :actions] actions) + (assoc-in k {:html html :version v}) + trim-versions)))))))] + (get-in state (into [:tabs tab-id :renders] (conj k :version))))) + +(defn evict-renders-before! + "Drop the render versions before `version`, the page version the client + has applied: a full render replaces everything rendered before it, so no + click can name them any more. The latest page version is always kept." + [app-state* tab-id version] + (when version + (swap! app-state* + (fn [state] + (if-not (contains? (:tabs state) tab-id) + state + (update-in state [:tabs tab-id :renders :versions] + (fn [versions] + (let [page-v (get-in state [:tabs tab-id :renders :page :version])] + (into {} (remove (fn [[v _]] (and (< v version) (not= v page-v)))) + versions)))))))) + nil) + +(defn find-rendered-action + "The action `action-id` named in render `version` of tab `tab-id`, or in its + latest page render when version is nil. nil when that render is gone." + [app-state* tab-id version action-id] + (let [renders (get-in @app-state* [:tabs tab-id :renders]) + version (or version (get-in renders [:page :version]))] + (get-in renders [:versions version :actions action-id]))) + (defn execute-action! "Execute an action by ID with error handling. When client-params are provided they are passed to the action fn." diff --git a/src/hyper/context.clj b/src/hyper/context.clj index 3fb6a8e..dedd4e8 100644 --- a/src/hyper/context.clj +++ b/src/hyper/context.clj @@ -39,6 +39,12 @@ ;; in a single atomic swap — no cleanup-before-render gap needed. (def ^:dynamic *registered-action-ids* nil) +;; The actions a render pass registered, as {action-id action-data}. +;; Bound to (atom {}) before each render; stored afterwards under the +;; render's version, so a click resolves its action id against the render +;; it was made on (see hyper.actions/record-render!). +(def ^:dynamic *rendered-actions* nil) + ;; State overlay for cursor read/write indirection. ;; ;; When non-nil, a map with: @@ -180,6 +186,7 @@ #'*region-path* [] #'*declared-signals* (atom []) #'*registered-action-ids* (atom #{}) + #'*rendered-actions* (atom {}) #'*registered-subview-ids* (atom #{}) #'*render-guard* (make-guard (get @app-state* :render-guard :warn)) #'*state-overlay* {:state* (atom @app-state*) @@ -195,6 +202,7 @@ #'*region-path* [] #'*declared-signals* (atom []) #'*registered-action-ids* (atom #{}) + #'*rendered-actions* (atom {}) #'*registered-subview-ids* (atom #{}) ;; Partial reactive renders have no setup phase — the body is a pure ;; render fn, so the guard is active immediately. diff --git a/src/hyper/core.clj b/src/hyper/core.clj index dcde877..f54a29c 100644 --- a/src/hyper/core.clj +++ b/src/hyper/core.clj @@ -912,7 +912,6 @@ tab-id (:hyper/tab-id *request*)] (when-let [route (routes/tab-route router route-name params query-params)] (let [href (routes/route-url router route) - base-path (get @app-state* :base-path "") ;; Use live-routes to always get the latest route metadata route-index (routes/live-route-index app-state*) ;; Resolve title eagerly for the pushState call @@ -935,7 +934,7 @@ {:href href :data-on:click__prevent (str "window.hyper.startNavigation('" escaped-href "');" - " @post('" base-path "/hyper/actions?action-id=" action-id "');" + " @hyperAction('" action-id "');" " window.history.pushState({title: '" escaped-title "'}, '', '" escaped-href "');" (when title (str " document.title = '" escaped-title "'")))}))))) diff --git a/src/hyper/render.clj b/src/hyper/render.clj index 342ac78..2148559 100644 --- a/src/hyper/render.clj +++ b/src/hyper/render.clj @@ -4,6 +4,7 @@ Handles rendering hiccup to HTML and formatting Datastar SSE events." (:require [clojure.string :as string] [dev.onionpancakes.chassis.core :as c] + [hyper.actions :as actions] [hyper.component.bundle :as component.bundle] [hyper.context :as context] [hyper.lifecycle :as lifecycle] @@ -291,6 +292,8 @@ :body-html - HTML string of the rendered page body :url - current route URL string, or nil :declared-signals - vector of signal declaration maps for HTML injection + :render-version - the version the render's actions are kept under + (see hyper.actions/record-render!) Binds `context/*request*` and `context/*action-idx*` for the duration of both rendering and HTML serialization, so lazy hiccup sequences @@ -395,7 +398,11 @@ :url url :declared-signals declared :registered-action-ids action-ids - :registered-subview-ids subview-ids}))) + :registered-subview-ids subview-ids + :render-version (actions/record-render! + app-state* tab-id + {:html body-html + :actions @context/*rendered-actions*})}))) (finally (pop-thread-bindings))))))) diff --git a/src/hyper/server.clj b/src/hyper/server.clj index 10410c0..c13a8ee 100644 --- a/src/hyper/server.clj +++ b/src/hyper/server.clj @@ -182,7 +182,7 @@ ;; Normal render — assemble and send SSE payload (let [{:keys [title head-html body-html url declared-signals registered-action-ids - registered-subview-ids]} render-result] + registered-subview-ids render-version]} render-result] ;; Sweep stale actions + render-scoped subviews (reactive regions) (actions/sweep-stale-tab-actions! app-state* tab-id registered-action-ids) (subview/sweep-stale! app-state* tab-id registered-subview-ids) @@ -196,8 +196,9 @@ sig-attrs (signal/format-signal-attrs declared-signals) div-attrs (cond-> {:id "hyper-app"} (:tree-shake? @app-state*) (assoc :data-hyper-squint-version (squint-core-version app-state*)) - url (assoc :data-hyper-url url) - sig-attrs (merge sig-attrs)) + url (assoc :data-hyper-url url) + render-version (assoc :data-hyper-render-version render-version) + sig-attrs (merge sig-attrs)) wrapped-html (c/html [:div div-attrs (c/raw body-html)]) body-event (render/format-datastar-fragment wrapped-html) ;; Keep only patches that add information beyond the body @@ -616,12 +617,15 @@ {} qp)))) +(declare read-body run-action! queued-actions-handler) + (defn action-handler "Handler for action POST requests. - All actions use Datastar's `@post()`, which sends all non-underscore - signals as a JSON body. Client params ($value, $checked, etc.) are - passed as URL query parameters. + Pages post their action queue as `?tab-id=` (see `queued-actions-handler`). + A single action can also be posted as `?action-id=`, with the signals as + the JSON body and client params ($value, $checked, etc.) as URL query + parameters: - Parses the body as signal values and binds them to `context/*signals*` - Extracts client params from URL query parameters (JSON-decoded) @@ -631,60 +635,26 @@ - Queues any pending scripts to the renderer for SSE delivery" [app-state*] (fn [req] - (let [action-id (get-in req [:query-params "action-id"])] + (let [action-id (get-in req [:query-params "action-id"]) + tab-id (get-in req [:query-params "tab-id"])] + + (cond + (and (not action-id) tab-id) + (queued-actions-handler app-state* req tab-id) - (if-not action-id + (not action-id) {:status 400 :headers {"Content-Type" "application/json"} :body "{\"error\": \"Missing action-id\"}"} - (let [req-with-state (assoc req - :hyper/app-state app-state* - :hyper/router (get @app-state* :router)) - raw-body (try - (when-let [body (:body req)] - (let [s (if (string? body) body (slurp body))] - (when-not (clojure.string/blank? s) s))) - (catch Exception _ nil)) - signals (when raw-body - (signal/parse-signals raw-body)) - client-params (parse-client-query-params req) - ;; Sync client signal values into server state so the - ;; render loop can detect changes (e.g. when a user types - ;; into a data-bind input, the server needs to know the - ;; latest value for changed-signals diffing). Recording - ;; them under :client-signals too keeps the render loop - ;; from echoing them back as patches. - action-data (get-in @app-state* [:actions action-id]) - tab-id (:tab-id action-data)] - (when (and signals tab-id) - (swap! app-state* update-in [:tabs tab-id] - (fn [tab] - (-> tab - (update :signals merge signals) - (update :client-signals merge signals)))) - ;; Persist auto-commit optimistics before the action body runs, - ;; so cursor reads in the action see the committed value. - (signal/auto-commit! app-state* tab-id signals)) - (when-let [env (:hyper/env req)] - (when tab-id - (swap! app-state* assoc-in [:tabs tab-id :env] env))) - (push-thread-bindings {#'context/*request* req-with-state - #'context/*signals* signals - #'context/*action-name* (:as action-data) - #'effects/*pending* (effects/init-pending)}) + :else + + (let [signals (some-> (read-body req) signal/parse-signals) + client-params (parse-client-query-params req) + action-data (get-in @app-state* [:actions action-id])] (try - (actions/execute-action! app-state* action-id client-params) - - ;; Collect accumulated effects - (let [pending (effects/collect-pending!) - ;; Queue pending scripts for SSE delivery via the renderer thread - _ (when-let [scripts (seq (:scripts pending))] - (when-let [renderer (get-in @app-state* [:tabs tab-id :renderer])] - ((:enqueue-scripts! renderer) scripts))) - ;; Build response — 204 with any cookies from effects - response {:status 204}] - (effects/apply-cookies-to-response response pending)) + (let [pending (run-action! app-state* req action-id action-data signals client-params)] + (effects/apply-cookies-to-response {:status 204} pending)) (catch Exception e (t/error! {:id :hyper.error/action-handler :msg "Error executing action handler" @@ -692,9 +662,126 @@ e) {:status 500 :headers {"Content-Type" "application/json"} - :body (json/generate-string {:error (.getMessage e)})}) - (finally - (pop-thread-bindings)))))))) + :body (json/generate-string {:error (.getMessage e)})}))))))) + +(defn- read-body + "The request body as a string, or nil when it is empty or unreadable." + [req] + (try + (when-let [body (:body req)] + (let [s (if (string? body) body (slurp body))] + (when-not (clojure.string/blank? s) s))) + (catch Exception _ nil))) + +(defn- run-action! + "Run `action-data`'s fn as the action `action-id` with the request's + `signals` and `client-params`, and return its pending effects, after + queueing its scripts for the renderer. Throws when the action is gone." + [app-state* req action-id action-data signals client-params] + (when-not action-data + (t/log! {:level :warn + :id :hyper.error/action-not-found + :data {:hyper/action-id action-id} + :msg "Action not found"}) + (throw (ex-info "Action not found" {:hyper/action-id action-id}))) + (let [tab-id (:tab-id action-data) + req-with-state (assoc req + :hyper/app-state app-state* + :hyper/router (get @app-state* :router))] + ;; Sync client signal values into server state so the + ;; render loop can detect changes (e.g. when a user types + ;; into a data-bind input, the server needs to know the + ;; latest value for changed-signals diffing). Recording + ;; them under :client-signals too keeps the render loop + ;; from echoing them back as patches. + (when (and signals tab-id) + (swap! app-state* update-in [:tabs tab-id] + (fn [tab] + (-> tab + (update :signals merge signals) + (update :client-signals merge signals)))) + ;; Persist auto-commit optimistics before the action body runs, + ;; so cursor reads in the action see the committed value. + (signal/auto-commit! app-state* tab-id signals)) + (when-let [env (:hyper/env req)] + (when tab-id + (swap! app-state* assoc-in [:tabs tab-id :env] env))) + (binding [context/*request* req-with-state + context/*signals* signals + context/*action-name* (:as action-data) + effects/*pending* (effects/init-pending)] + (t/catch->error! :hyper.error/execute-action + ((:fn action-data) client-params)) + (let [pending (effects/collect-pending!)] + ;; Queue pending scripts for SSE delivery via the renderer thread + (when-let [scripts (seq (:scripts pending))] + (when-let [renderer (get-in @app-state* [:tabs tab-id :renderer])] + ((:enqueue-scripts! renderer) scripts))) + pending)))) + +(defn- action-lock + "The lock a tab's queued actions run under, created on first use; nil when + the tab is gone." + ^java.util.concurrent.locks.ReentrantLock [app-state* tab-id] + (-> (swap! app-state* (fn [state] + (if (and (contains? (:tabs state) tab-id) + (nil? (get-in state [:tabs tab-id :action-lock]))) + (assoc-in state [:tabs tab-id :action-lock] + (java.util.concurrent.locks.ReentrantLock.)) + state))) + (get-in [:tabs tab-id :action-lock]))) + +(defn- run-queued-action! + "Run one action from a tab's queue: action `id` of render `v`, with the + signals and client params it was made with. Returns its pending effects, + or nil when that render is gone." + [app-state* req tab-id {:keys [id v signals params]}] + (if-let [action-data (actions/find-rendered-action app-state* tab-id v id)] + (run-action! app-state* req id action-data + (some-> signals signal/parse-signals) + (some-> params (json/parse-string true))) + (t/log! {:level :warn + :id :hyper.error/action-not-found + :data {:hyper/action-id id :hyper/render-version v :hyper/tab-id tab-id} + :msg "Action not found: the render it was made on is gone"}))) + +(defn queued-actions-handler + "Handler for the queue `@hyperAction` posts for tab `tab-id`: + `{base, actions}`, where `actions` are the tab's actions whose requests have + not completed, `{id, seq, v, signals, params}` in the order they were made, + and `base` is the page render version the client shows. + + A tab's requests run one at a time. Actions with a sequence number the tab + has already run are skipped, so an action sent again, or a request that + arrives after a later one, runs nothing twice and nothing out of order. + Afterwards renders before `base` are dropped: no click can name them." + [app-state* req tab-id] + (let [lock (action-lock app-state* tab-id)] + (if (or (nil? lock) + ;; A tab is linked to its session once its SSE stream connects + (when-let [session-id (get-in @app-state* [:tabs tab-id :session-id])] + (not= session-id (:hyper/session-id req)))) + {:status 404 + :headers {"Content-Type" "application/json"} + :body "{\"error\": \"Unknown tab\"}"} + (let [{:keys [base actions]} (json/parse-string (read-body req) true)] + (.lock lock) + (try + (let [last-seq (get-in @app-state* [:tabs tab-id :action-seq] 0) + pendings (->> actions + (filter #(< last-seq (:seq %))) + (sort-by :seq) + (mapv (fn [{:keys [seq] :as queued}] + (swap! app-state* assoc-in [:tabs tab-id :action-seq] seq) + (run-queued-action! app-state* req tab-id queued))))] + (actions/evict-renders-before! app-state* tab-id base) + (reduce (fn [response pending] + (cond-> response + pending (effects/apply-cookies-to-response pending))) + {:status 204} + pendings)) + (finally + (.unlock lock))))))) (defn- trigger-tab-render! "Enqueue a full render for `tab-id` on its currently attached renderer (if @@ -915,6 +1002,62 @@ })(); "))]) +(defn datastar-src + "The module URL Datastar is loaded from: the `:src` of the (first) script + in the `:datastar-script` hiccup, or nil." + [datastar-script] + (->> (tree-seq sequential? seq datastar-script) + (some (fn [node] + (when (and (vector? node) (= :script (first node)) (map? (second node))) + (:src (second node))))))) + +(defn action-script + "A module script that adds the `@hyperAction(id, clientParams)` Datastar + action, imported from the same module URL as Datastar so it registers with + the page's Datastar. Nil, with a warning, when that URL is unknown. + + Each call numbers the action and queues it with the page's signals as they + are now, the client params, and the render version of the HTML it was made + on (`data-hyper-render-version` on the nearest region or #hyper-app). Every + request posts all actions whose requests have not completed, so the server, + which skips sequence numbers it has already run, runs each action once and + in the order they were made, whichever request arrives first." + [datastar-script tab-id base-path] + (if-let [src (datastar-src datastar-script)] + [:script {:type "module"} + (c/raw + (str " +import { action, filtered } from '" (utils/escape-js-string src) "'; +const url = '" base-path "/hyper/actions?tab-id=" tab-id "'; +let lastSeq = 0; +let queue = []; +const versionOf = (el) => { + const v = (el && el.closest && el.closest('[data-hyper-render-version]') + || document.getElementById('hyper-app')) + ?.getAttribute('data-hyper-render-version'); + return v == null ? null : parseInt(v, 10); +}; +action({ + name: 'hyperAction', + apply({ el, error }, id, params) { + if (!id) throw error('HyperActionNoIdProvided'); + const seq = ++lastSeq; + queue.push({ id, seq, v: versionOf(el), + signals: JSON.stringify(filtered({ include: /.*/, exclude: /(^|\\.)_/ })), + params: params === undefined ? null : JSON.stringify(params) }); + return fetch(url, { + method: 'POST', + headers: { 'Content-Type': 'application/json' }, + body: JSON.stringify({ base: versionOf(document.getElementById('hyper-app')), actions: queue }) + }).catch((e) => console.error('hyper: action request failed', e)) + .finally(() => { queue = queue.filter((a) => a.seq > seq); }); + } +}); +"))] + (t/log! {:level :warn + :id :hyper.warn/no-datastar-src + :msg "No Datastar module URL in :datastar-script, so @hyperAction is not registered and actions won't run."}))) + (defn sse-connect-expr "The Datastar `@get` expression that opens (or re-opens) this tab's SSE connection. Shared by the initial `` `data-init` and `h/reconnect` @@ -941,6 +1084,7 @@ div-attrs (cond-> {:id "hyper-app"} tree-shake? (assoc :data-hyper-squint-version core-version) (:url result) (assoc :data-hyper-url (:url result)) + (:render-version result) (assoc :data-hyper-render-version (:render-version result)) sig-attrs (merge sig-attrs)) ;; WebKit/Safari fetch-streaming strand workaround: inject the ;; EventSource shim only for affected user agents, before the datastar @@ -962,6 +1106,7 @@ "window.hyper_sc = sc;" (when tree-shake? (str "\nwindow.hyper_squint_version = '" core-version "';"))))] datastar-script + (action-script datastar-script tab-id base-path) (when head-html (c/raw head-html))] [:body (merge diff --git a/src/hyper/subview.clj b/src/hyper/subview.clj index db0b73a..2b22d6f 100644 --- a/src/hyper/subview.clj +++ b/src/hyper/subview.clj @@ -22,7 +22,9 @@ re-renders just this subview (a targeted Datastar fragment), `:full` triggers a full page re-render." (:require [clojure.set] + [clojure.string :as str] [dev.onionpancakes.chassis.core :as c] + [hyper.actions :as actions] [hyper.context :as context] [hyper.protocols :as proto] [hyper.watch :as watch] @@ -89,6 +91,13 @@ [id hiccup] [id (into [tag (assoc attrs :id id)] children)])))) +(defn with-render-version + "`html`, a single rooted element, with `data-hyper-render-version` set to + `version` on its root." + [version html] + (str/replace-first html #"^<([A-Za-z][A-Za-z0-9-]*)" + (str "<$1 data-hyper-render-version=\"" version "\""))) + (defn- check-region-unique! "Throw when `id` was already registered by an earlier region in this render. Positional ids are unique by construction, so a clash always means two @@ -193,13 +202,20 @@ (let [body (binding [context/*region-path* (:region-path spec [])] (render-fn)) [_id hiccup] (resolve-region-id sid sid body) - html (c/html hiccup)] + html (c/html hiccup) + version (actions/record-render! app-state* tab-id + {:region sid + :html html + :actions @context/*rendered-actions*})] (swap! app-state* assoc-in [:tabs tab-id :subviews sid] (assoc spec :dep-vals (mapv deref deps) :cached-html html :html-id sid)) - html) + ;; The region's actions are counted from zero, so a click in it + ;; names this render's version rather than the page's. + (cond->> html + version (with-render-version version))) (finally (pop-thread-bindings))))))) diff --git a/test/hyper/action_queue_test.clj b/test/hyper/action_queue_test.clj new file mode 100644 index 0000000..027e20c --- /dev/null +++ b/test/hyper/action_queue_test.clj @@ -0,0 +1,111 @@ +(ns hyper.action-queue-test + "The action queue `@hyperAction` posts: actions run once, in the order they + were made, against the render they were made on." + (:require [cheshire.core :as json] + [clojure.test :refer [deftest is testing]] + [hyper.core :as h] + [hyper.render :as render] + [hyper.state :as state])) + +(defn- page-handler + "A hyper handler serving `page` at /, and its app-state." + [page] + (let [app* (atom (state/init-state))] + [(h/create-handler [["/" {:name :home :get page}]] :app-state app*) app*])) + +(defn- get-page [handler] + (:body (handler {:request-method :get :uri "/" :query-string "tab-id=T" :headers {}}))) + +(defn- action-id + "The id of the action on the element whose text is `label`." + [html label] + (second (re-find (re-pattern (str "hyperAction\\('(a_T_\\d+)'[^\"]*\">" label "<")) html))) + +(defn- render-version [html] + (some-> (re-find #"id=\"hyper-app\"[^>]*data-hyper-render-version=\"(\d+)\"" html) second parse-long)) + +(defn- post-queue! + "Post `actions` as the page's queue, as @hyperAction does." + [handler base actions] + (handler {:request-method :post + :uri "/hyper/actions" + :query-string "tab-id=T" + :headers {"content-type" "application/json"} + :body (json/generate-string {:base base :actions actions})})) + +(defn- queued + "An action as @hyperAction queues it." + [{:keys [id seq v value]}] + {:id id + :seq seq + :v v + :signals "{}" + :params (when value (json/generate-string {:value value}))}) + +(defn- rerender! [app*] + (render/render-tab app* (get-in @app* [:tabs "T" :session-id]) "T")) + +(deftest test-actions-run-in-the-order-they-were-made + (let [[handler app*] (page-handler + (fn [_] + [:div + [:select {:data-on:change (h/action (swap! (h/tab-cursor :picks []) conj $value))}] + [:span "picks"]])) + html (get-page handler) + v (render-version html) + id (second (re-find #"hyperAction\('(a_T_\d+)" html)) + bmw (queued {:id id :seq 1 :v v :value "BMW"}) + kia (queued {:id id :seq 2 :v v :value "Kia"}) + picks #(get-in @app* [:tabs "T" :data :picks])] + (testing "the later request arrives first, carrying both actions" + (is (= 204 (:status (post-queue! handler v [bmw kia])))) + (is (= ["BMW" "Kia"] (picks)))) + (testing "the earlier request arrives last: its action already ran" + (is (= 204 (:status (post-queue! handler v [bmw])))) + (is (= ["BMW" "Kia"] (picks)))) + (testing "a new action runs once, however often it is sent" + (let [vw (queued {:id id :seq 3 :v v :value "VW"})] + (post-queue! handler v [vw]) + (post-queue! handler v [vw]) + (is (= ["BMW" "Kia" "VW"] (picks))))))) + +(deftest test-actions-run-against-the-render-they-were-made-on + (let [[handler app*] (page-handler + (fn [_] + [:ul + (for [item @(h/tab-cursor :items ["Apples" "Bread" "Dates" "Eggs"])] + [:li [:button {:data-on:click (h/action (swap! (h/tab-cursor :items) #(vec (remove #{item} %))))} + (str "Remove " item)]])])) + html (get-page handler) + v1 (render-version html) + items #(get-in @app* [:tabs "T" :data :items])] + (post-queue! handler v1 [(queued {:id (action-id html "Remove Apples") :seq 1 :v v1})]) + (let [v2 (:render-version (rerender! app*))] + (is (not= v1 v2) "removing a row is a new render") + (testing "a click made on the first render runs that render's action" + (post-queue! handler v1 [(queued {:id (action-id html "Remove Dates") :seq 2 :v v1})]) + (is (= ["Bread" "Eggs"] (items))))))) + +(deftest test-render-versions + (let [[handler app*] (page-handler (fn [_] [:div "n=" @(h/tab-cursor :n 0) + [:button {:data-on:click (h/action (swap! (h/tab-cursor :n) inc))} "+"]])) + html (get-page handler) + v1 (render-version html) + id (action-id html "\\+")] + (testing "a render of the same HTML keeps the version" + (is (= v1 (:render-version (rerender! app*))))) + (testing "a render of different HTML gets a new version" + (post-queue! handler v1 [(queued {:id id :seq 1 :v v1})]) + (let [v2 (:render-version (rerender! app*))] + (is (< v1 v2)) + (testing "and once the client shows it, earlier renders are dropped" + (post-queue! handler v2 []) + (is (= 1 (get-in @app* [:tabs "T" :data :n]))) + (post-queue! handler v2 [(queued {:id id :seq 2 :v v1})]) + (is (= 1 (get-in @app* [:tabs "T" :data :n])) "a click on a dropped render runs nothing") + (post-queue! handler v2 [(queued {:id id :seq 3 :v v2})]) + (is (= 2 (get-in @app* [:tabs "T" :data :n])))))))) + +(deftest test-unknown-tab + (let [[handler _] (page-handler (fn [_] [:div]))] + (is (= 404 (:status (post-queue! handler nil [(queued {:id "a_T_1" :seq 1})])))))) diff --git a/test/hyper/async_test.clj b/test/hyper/async_test.clj index 5686e8c..9d66824 100644 --- a/test/hyper/async_test.clj +++ b/test/hyper/async_test.clj @@ -80,7 +80,7 @@ "cell flips to :ready when the worker lands") (is (= {:status :ready :result :rows} @(cell app-state* "t" "async_t_1"))) (is (= 1 @fetched) "fetched exactly once") - (is (= "
:ready|:rows
" + (is (= "
:ready|:rows
" (subview/partial-render app-state* "t" "async_t_1")) "a partial re-render renders the ready result") (subview/teardown-all! app-state* "t"))))) diff --git a/test/hyper/core_test.clj b/test/hyper/core_test.clj index 749e440..28f75ee 100644 --- a/test/hyper/core_test.clj +++ b/test/hyper/core_test.clj @@ -1,11 +1,13 @@ (ns hyper.core-test (:require [clojure.string :as string] [clojure.test :refer [deftest is testing]] + [dev.onionpancakes.chassis.core :as c] [hyper.context :as context] [hyper.core :as hy] [hyper.datastar :as datastar] [hyper.render :as render] [hyper.render.error :as render.error] + [hyper.server :as server] [hyper.signal :as signal] [hyper.state :as state] [hyper.test :as ht] @@ -99,12 +101,10 @@ (let [action-expr (hy/action (reset! executed true)) action-js (str action-expr)] (is (datastar/datastar-expr? action-expr)) - (is (.contains action-js "@post")) - (is (.contains action-js "/hyper/actions")) - (is (.contains action-js "action-id=")) + (is (.contains action-js "@hyperAction('")) ;; Extract action ID and execute it - (let [action-id (second (re-find #"action-id=([^']+)" action-js))] + (let [action-id (second (re-find #"@hyperAction\('([^']+)'" action-js))] (is (some? action-id)) ((get-in @app-state* [:actions action-id :fn]) nil) (is @executed))))))) @@ -137,8 +137,7 @@ (is (map? nav-attrs)) (is (= "/" (:href nav-attrs))) (is (contains? nav-attrs :data-on:click__prevent)) - (is (.contains (str (:data-on:click__prevent nav-attrs)) "@post")) - (is (.contains (str (:data-on:click__prevent nav-attrs)) "/hyper/actions")) + (is (.contains (str (:data-on:click__prevent nav-attrs)) "@hyperAction('")) (is (.contains (str (:data-on:click__prevent nav-attrs)) "pushState")) (is (.contains (str (:data-on:click__prevent nav-attrs)) "window.hyper.startNavigation('/');"))))) @@ -171,7 +170,7 @@ (binding [context/*request* ctx] (let [nav-attrs (hy/navigate :about) - action-id (second (re-find #"action-id=([^']+)" + action-id (second (re-find #"@hyperAction\('([^']+)'" (str (:data-on:click__prevent nav-attrs)))) _ (do (is (some? action-id)) ((get-in @app-state* [:actions action-id :fn]) nil)) @@ -366,7 +365,7 @@ (is (= 11 @cursor))))))) (deftest test-action-with-client-params - (testing "$value client param generates @post expression with hyper.encodeClientParams" + (testing "$value client param generates an @hyperAction expression with client params" (let [app-state* (atom (state/init-state)) session-id "test-session-cp" tab-id "test_tab_cp"] @@ -376,15 +375,14 @@ :hyper/app-state app-state*}] (let [action-expr (str (hy/action (reset! (hy/tab-cursor :query) $value)))] (is (string? action-expr)) - (is (.contains action-expr "@post(")) - (is (.contains action-expr "hyper.encodeClientParams")) - (is (.contains action-expr "value:evt.target.value")) - (let [action-id (second (re-find #"action-id=([^'&\"]+)" action-expr))] + (is (.contains action-expr "@hyperAction(")) + (is (.contains action-expr "{value:evt.target.value}")) + (let [action-id (second (re-find #"@hyperAction\('([^']+)'" action-expr))] (is (some? action-id)) ((get-in @app-state* [:actions action-id :fn]) {:value "hello"}) (is (= "hello" (get-in @app-state* [:tabs tab-id :data :query])))))))) - (testing "$checked client param generates @post expression" + (testing "$checked client param generates an @hyperAction expression" (let [app-state* (atom (state/init-state)) session-id "test-session-cp" tab-id "test_tab_cp"] @@ -394,12 +392,12 @@ :hyper/app-state app-state*}] (let [action-expr (str (hy/action (reset! (hy/tab-cursor :dark?) $checked)))] (is (.contains action-expr "checked:evt.target.checked")) - (let [action-id (second (re-find #"action-id=([^'&\"]+)" action-expr))] + (let [action-id (second (re-find #"@hyperAction\('([^']+)'" action-expr))] (is (some? action-id)) ((get-in @app-state* [:actions action-id :fn]) {:checked true}) (is (= true (get-in @app-state* [:tabs tab-id :data :dark?])))))))) - (testing "$key client param generates @post expression" + (testing "$key client param generates an @hyperAction expression" (let [app-state* (atom (state/init-state)) session-id "test-session-cp" tab-id "test_tab_cp"] @@ -409,12 +407,12 @@ :hyper/app-state app-state*}] (let [action-expr (str (hy/action (reset! (hy/tab-cursor :last-key) $key)))] (is (.contains action-expr "key:evt.key")) - (let [action-id (second (re-find #"action-id=([^'&\"]+)" action-expr))] + (let [action-id (second (re-find #"@hyperAction\('([^']+)'" action-expr))] (is (some? action-id)) ((get-in @app-state* [:actions action-id :fn]) {:key "Enter"}) (is (= "Enter" (get-in @app-state* [:tabs tab-id :data :last-key])))))))) - (testing "$form-data client param generates @post expression" + (testing "$form-data client param generates an @hyperAction expression" (let [app-state* (atom (state/init-state)) session-id "test-session-cp" tab-id "test_tab_cp"] @@ -424,13 +422,13 @@ :hyper/app-state app-state*}] (let [action-expr (str (hy/action (reset! (hy/tab-cursor :form) $form-data)))] (is (.contains action-expr "formData:Object.fromEntries")) - (let [action-id (second (re-find #"action-id=([^'&\"]+)" action-expr))] + (let [action-id (second (re-find #"@hyperAction\('([^']+)'" action-expr))] (is (some? action-id)) ((get-in @app-state* [:actions action-id :fn]) {:formData {:email "a@b.com" :name "Alice"}}) (is (= {:email "a@b.com" :name "Alice"} (get-in @app-state* [:tabs tab-id :data :form])))))))) - (testing "no client params uses simple @post expression" + (testing "no client params uses a plain @hyperAction expression" (let [app-state* (atom (state/init-state)) session-id "test-session-cp" tab-id "test_tab_cp"] @@ -439,8 +437,8 @@ :hyper/tab-id tab-id :hyper/app-state app-state*}] (let [action-expr (str (hy/action (swap! (hy/tab-cursor :count 0) inc)))] - (is (.contains action-expr "@post(")) - (is (not (.contains action-expr "hyper.encodeClientParams"))))))) + (is (.contains action-expr "@hyperAction(")) + (is (not (.contains action-expr ", {"))))))) (testing "multiple client params in single action" (let [app-state* (atom (state/init-state)) @@ -452,12 +450,12 @@ :hyper/app-state app-state*}] (let [action-expr (str (hy/action (do (reset! (hy/tab-cursor :val) $value) (reset! (hy/tab-cursor :k) $key))))] - (is (.contains action-expr "@post(")) - (is (.contains action-expr "hyper.encodeClientParams")) + (is (.contains action-expr "@hyperAction(")) + (is (.contains action-expr ", {")) (is (.contains action-expr "value:evt.target.value")) (is (.contains action-expr "key:evt.key")))))) - (testing "JS string with client params injects guard before @post" + (testing "JS string with client params injects guard before @hyperAction" (let [app-state* (atom (state/init-state)) session-id "test-session-js" tab-id "test_tab_js"] @@ -469,12 +467,12 @@ (reset! (hy/tab-cursor :val) $value)))] (is (string? action-expr)) (is (.contains action-expr "evt.key === 'Enter'")) - (is (.contains action-expr "@post(")) - (is (.contains action-expr "hyper.encodeClientParams")) + (is (.contains action-expr "@hyperAction(")) + (is (.contains action-expr ", {")) (is (.contains action-expr "value:evt.target.value")) (is (.startsWith action-expr "evt.key === 'Enter' && ")) ;; Verify action executes correctly with client params - (let [action-id (second (re-find #"action-id=([^'&\"]+)" action-expr))] + (let [action-id (second (re-find #"@hyperAction\('([^']+)'" action-expr))] (is (some? action-id)) ((get-in @app-state* [:actions action-id :fn]) {:value "hello"}) (is (= "hello" (get-in @app-state* [:tabs tab-id :data :val])))))))) @@ -488,8 +486,8 @@ :hyper/tab-id tab-id :hyper/app-state app-state*}] (let [action-expr (str (hy/action {:when ""} (reset! (hy/tab-cursor :val) $value)))] - (is (.contains action-expr "@post(")) - (is (.contains action-expr "hyper.encodeClientParams")) + (is (.contains action-expr "@hyperAction(")) + (is (.contains action-expr ", {")) (is (.contains action-expr "value:evt.target.value")) (is (not (.contains action-expr " && "))))))) @@ -504,7 +502,7 @@ (let [action-expr (str (hy/action {:when (hy/expr (= evt.key "Enter"))} (reset! (hy/tab-cursor :val) $value)))] (is (.startsWith action-expr "(evt.key === \"Enter\") && ")) - (is (.contains action-expr "@post(")))))) + (is (.contains action-expr "@hyperAction(")))))) (testing ":when guard evaluating to a non-string throws" (let [app-state* (atom (state/init-state)) @@ -519,43 +517,20 @@ (hy/action {:when 42} (reset! (hy/tab-cursor :val) $value)))))))) (deftest test-base-path-action - (testing "action macro uses /hyper/actions without :base-path" - (let [app-state* (atom (state/init-state)) - session-id "test-session-bp" - tab-id "test_tab_bp"] - (state/get-or-create-tab! app-state* session-id tab-id) - (binding [context/*request* {:hyper/session-id session-id - :hyper/tab-id tab-id - :hyper/app-state app-state*}] - (let [action-expr (str (hy/action (swap! (hy/tab-cursor :n 0) inc)))] - (is (string/includes? action-expr "@post('/hyper/actions?")))))) + (testing "the action script posts to /hyper/actions without :base-path" + (is (string/includes? (c/html (server/action-script (server/default-datastar-script) "t1" "")) + "'/hyper/actions?tab-id=t1'"))) - (testing "action macro prefixes /hyper/actions with :base-path" - (let [app-state* (atom (assoc (state/init-state) :base-path "/my-app")) - session-id "test-session-bp" - tab-id "test_tab_bp"] - (state/get-or-create-tab! app-state* session-id tab-id) - (binding [context/*request* {:hyper/session-id session-id - :hyper/tab-id tab-id - :hyper/app-state app-state*}] - (let [action-expr (str (hy/action (swap! (hy/tab-cursor :n 0) inc)))] - (is (string/includes? action-expr "@post('/my-app/hyper/actions?")) - (is (not (string/includes? action-expr "@post('/hyper/actions?"))))))) - - (testing "action macro with client params also prefixes the URL" - (let [app-state* (atom (assoc (state/init-state) :base-path "/sub")) - session-id "test-session-bp2" - tab-id "test_tab_bp2"] - (state/get-or-create-tab! app-state* session-id tab-id) - (binding [context/*request* {:hyper/session-id session-id - :hyper/tab-id tab-id - :hyper/app-state app-state*}] - (let [action-expr (str (hy/action (reset! (hy/tab-cursor :v) $value)))] - (is (string/includes? action-expr "@post('/sub/hyper/actions?")) - (is (string/includes? action-expr "hyper.encodeClientParams")))))) + (testing "the action script prefixes /hyper/actions with :base-path" + (is (string/includes? (c/html (server/action-script (server/default-datastar-script) "t1" "/my-app")) + "'/my-app/hyper/actions?tab-id=t1'"))) + + (testing "the action script imports the page's Datastar" + (is (string/includes? (c/html (server/action-script [:script {:type "module" :src "/js/ds.js"}] "t1" "")) + "from '/js/ds.js'"))) - (testing "action macro with :when guard and :base-path" - (let [app-state* (atom (assoc (state/init-state) :base-path "/app")) + (testing "action macro with :when guard" + (let [app-state* (atom (state/init-state)) session-id "test-session-bp3" tab-id "test_tab_bp3"] (state/get-or-create-tab! app-state* session-id tab-id) @@ -564,37 +539,7 @@ :hyper/app-state app-state*}] (let [action-expr (str (hy/action {:when "evt.key === 'Enter'"} (swap! (hy/tab-cursor :n 0) inc)))] - (is (string/includes? action-expr "@post('/app/hyper/actions?")) - (is (string/starts-with? action-expr "evt.key === 'Enter' && "))))))) - -(deftest test-base-path-navigate - (testing "navigate uses /hyper/actions without :base-path" - (let [routes [["/" {:name :home :get (fn [_] [:div "Home"])}] - ["/about" {:name :about :get (fn [_] [:div "About"])}]] - ctx (make-test-context routes)] - (binding [context/*request* ctx] - (let [nav-attrs (hy/navigate :about)] - (is (string/includes? (str (:data-on:click__prevent nav-attrs)) - "@post('/hyper/actions?")))))) - - (testing "navigate prefixes /hyper/actions with :base-path" - (let [routes [["/" {:name :home :get (fn [_] [:div "Home"])}] - ["/about" {:name :about :get (fn [_] [:div "About"])}]] - app-state* (atom (assoc (state/init-state) :base-path "/my-app")) - session-id "test-session-nav-bp" - tab-id "test_tab_nav_bp" - router (ring/router routes {:conflicts nil})] - (state/get-or-create-tab! app-state* session-id tab-id) - (swap! app-state* assoc :router router :routes routes) - (binding [context/*request* {:hyper/session-id session-id - :hyper/tab-id tab-id - :hyper/app-state app-state* - :hyper/router router}] - (let [nav-attrs (hy/navigate :about)] - (is (string/includes? (str (:data-on:click__prevent nav-attrs)) - "@post('/my-app/hyper/actions?")) - (is (not (string/includes? (str (:data-on:click__prevent nav-attrs)) - "@post('/hyper/actions?")))))))) + (is (string/starts-with? action-expr "evt.key === 'Enter' && @hyperAction('"))))))) ;; --------------------------------------------------------------------------- ;; Batch diff --git a/test/hyper/expr_test.clj b/test/hyper/expr_test.clj index 19af1e0..3fc1132 100644 --- a/test/hyper/expr_test.clj +++ b/test/hyper/expr_test.clj @@ -229,10 +229,10 @@ ;; --------------------------------------------------------------------------- (deftest test-action-in-expr - (testing "a bare action splices its raw @post(...) into the expression" + (testing "a bare action splices its raw @hyperAction(...) into the expression" (let [app-state* (new-tab)] (rendering app-state* - (is (= "@post('/hyper/actions?action-id=a_t_1')" + (is (= "@hyperAction('a_t_1')" (h/expr (h/action (reset! (h/tab-cursor :q) 1)))))))) (testing "an action guarded by a client-side condition compiles to a ternary" @@ -241,7 +241,7 @@ (let [out (h/expr (when (= evt.key "Enter") (h/action (reset! (h/tab-cursor :q) 2))))] (is (str/includes? out "evt.key === \"Enter\"")) - (is (str/includes? out "@post('/hyper/actions?action-id=a_t_1')")) + (is (str/includes? out "@hyperAction('a_t_1')")) (is (str/includes? out "?")) (is (not (str/includes? out "action("))))))) @@ -279,4 +279,4 @@ (let [out (h/expr (when (= $key "Enter") (h/action (reset! (h/tab-cursor :q) $value))))] (is (str/includes? out "evt.key === \"Enter\"")) - (is (str/includes? out "hyper.encodeClientParams({value:evt.target.value})"))))))) + (is (str/includes? out "@hyperAction('a_t_1', {value:evt.target.value})"))))))) diff --git a/test/hyper/jetty_sse_test.clj b/test/hyper/jetty_sse_test.clj index 6277ed2..884c312 100644 --- a/test/hyper/jetty_sse_test.clj +++ b/test/hyper/jetty_sse_test.clj @@ -184,7 +184,7 @@ (let [page (.body ^java.net.http.HttpResponse (GET client (str base "/?tab-id=T") (HttpResponse$BodyHandlers/ofString))) - action-id (second (re-find #"action-id=(a_T_\d+)" page))] + action-id (second (re-find #"hyperAction\('(a_T_\d+)" page))] (is (some? action-id) "the page renders an action with an id") ;; Open SSE and wait for the initial render (n=0). (let [resp (GET client (str base "/hyper/events?tab-id=T") @@ -231,7 +231,7 @@ (let [page (.body ^java.net.http.HttpResponse (GET client (str base "/?tab-id=T") (HttpResponse$BodyHandlers/ofString))) - action-id (second (re-find #"action-id=(a_T_\d+)" page))] + action-id (second (re-find #"hyperAction\('(a_T_\d+)" page))] (is (some? action-id) "the page renders an action with an id") (let [resp (GET client (str base "/hyper/events?tab-id=T") (HttpResponse$BodyHandlers/ofInputStream)) @@ -358,7 +358,7 @@ (let [page (.body ^java.net.http.HttpResponse (GET client (str base "/?tab-id=T") (HttpResponse$BodyHandlers/ofString))) - [commit-id clamp-id] (distinct (map second (re-seq #"action-id=(a_T_\d+)" page))) + [commit-id clamp-id] (distinct (map second (re-seq #"hyperAction\('(a_T_\d+)" page))) session-id (first (keys (:sessions @app*))) resp (GET client (str base "/hyper/events?tab-id=T") (HttpResponse$BodyHandlers/ofInputStream)) @@ -405,7 +405,7 @@ (let [page (.body ^java.net.http.HttpResponse (GET client (str base "/?tab-id=T") (HttpResponse$BodyHandlers/ofString))) - action-id (second (re-find #"action-id=(a_T_\d+)" page)) + action-id (second (re-find #"hyperAction\('(a_T_\d+)" page)) session-id (first (keys (:sessions @app*))) resp (GET client (str base "/hyper/events?tab-id=T") (HttpResponse$BodyHandlers/ofInputStream)) @@ -451,7 +451,7 @@ (HttpResponse$BodyHandlers/ofString))) _page-b (GET client (str base "/?tab-id=TB") (HttpResponse$BodyHandlers/ofString)) - commit-a (second (re-find #"action-id=(a_TA_\d+)" page-a)) + commit-a (second (re-find #"hyperAction\('(a_TA_\d+)" page-a)) session-id (first (keys (:sessions @app*))) resp-a (GET client (str base "/hyper/events?tab-id=TA") (HttpResponse$BodyHandlers/ofInputStream)) diff --git a/test/hyper/test_test.clj b/test/hyper/test_test.clj index a4f0a3a..b02c234 100644 --- a/test/hyper/test_test.clj +++ b/test/hyper/test_test.clj @@ -340,7 +340,7 @@ (fn [_req] [:a (h/navigate :about) "About"]) {:routes nav-routes})] (is (str/includes? (:body-html result) "href=\"/about\"")) - (is (str/includes? (:body-html result) "/hyper/actions")) + (is (str/includes? (:body-html result) "@hyperAction(")) (is (str/includes? (:body-html result) "pushState"))))) (deftest test-page-navigate-resolves-named-routes diff --git a/test/hyper/upload_test.clj b/test/hyper/upload_test.clj index 823bce1..f2e5419 100644 --- a/test/hyper/upload_test.clj +++ b/test/hyper/upload_test.clj @@ -109,10 +109,10 @@ (let [expr (uploads/build-expr "a_t_1" {'$form (client-params/client-param '$form)} nil "" ref)] (is (string/starts-with? expr "hyper.upload(")))) - (testing "no multipart param -> ordinary @post action expression" + (testing "no multipart param -> ordinary @hyperAction expression" (let [expr (uploads/build-expr "a_t_1" {'$value (client-params/client-param '$value)} nil "" nil)] - (is (string/starts-with? expr "@post(")))))) + (is (string/starts-with? expr "@hyperAction(")))))) ;; =========================================================================== ;; Upload endpoint handler From c38d0b731b4a6b2a44849f88efc701bc6991c2a0 Mon Sep 17 00:00:00 2001 From: Martin Kavalar Date: Wed, 4 Nov 2026 15:39:48 +0100 Subject: [PATCH 2/3] fix: embed client params written with h/expr as expressions An h/expr with a ; returns its value through __hyper_r, a statement that only works as a whole handler. As a client param it sits in an action's argument object or inside another expression, where it was a syntax error, so such a param is now wrapped in a function. --- src/hyper/client_params.clj | 18 +++++++++++++++++- src/hyper/core.clj | 2 +- src/hyper/expr.clj | 2 +- test/hyper/expr_test.clj | 21 +++++++++++++++++++++ 4 files changed, 40 insertions(+), 3 deletions(-) diff --git a/src/hyper/client_params.clj b/src/hyper/client_params.clj index a53eda0..3792bdd 100644 --- a/src/hyper/client_params.clj +++ b/src/hyper/client_params.clj @@ -11,7 +11,8 @@ switches the action's transport to a multipart/form-data upload (see hyper.uploads): its `:js` must evaluate to a `FormData` object (the request body), and its `:key` is the key under which the parsed upload is bound on - the server (\"form\" or \"files\").") + the server (\"form\" or \"files\")." + (:require [clojure.string :as str])) (def ^:private default-client-param-registry "The default registry of client params." @@ -65,6 +66,21 @@ {:symbol symbol :defined-symbols (defined-client-params)})))) +(defn- expression + "`js` as an expression. An `h/expr` with statements (see + `hyper.expr/join-statements`) returns its value through `__hyper_r`, + which only works as a whole handler, so it's wrapped in a function." + [js] + (if (and (string? js) (str/ends-with? js "return __hyper_r;")) + (str "(() => { " js " })()") + js)) + +(defn definition + "Client param `sym`'s definition, with its :js an expression that can sit + in an argument list, an object or another expression." + [sym] + (update (client-param sym) :js expression)) + (defn multipart-param? "True when `sym` is a client param whose transport is a multipart/form-data upload (its definition carries `:multipart? true`) rather than the default diff --git a/src/hyper/core.clj b/src/hyper/core.clj index f54a29c..9538d3a 100644 --- a/src/hyper/core.clj +++ b/src/hyper/core.clj @@ -703,7 +703,7 @@ (->> (client-params/defined-client-params) (filter all-syms) (reduce (fn [m sym] - (assoc m sym (client-params/client-param sym))) + (assoc m sym (client-params/definition sym))) {})))) (defmacro ^{:hyper/datastar-expr true} action diff --git a/src/hyper/expr.clj b/src/hyper/expr.clj index 74b1170..1bb9272 100644 --- a/src/hyper/expr.clj +++ b/src/hyper/expr.clj @@ -89,7 +89,7 @@ (walk/postwalk (fn [node] (if (and (symbol? node) (contains? params node)) - (list 'js* (:js (client-params/client-param node))) + (list 'js* (:js (client-params/definition node))) node)) form))) diff --git a/test/hyper/expr_test.clj b/test/hyper/expr_test.clj index 3fc1132..ca8d2d6 100644 --- a/test/hyper/expr_test.clj +++ b/test/hyper/expr_test.clj @@ -280,3 +280,24 @@ (h/action (reset! (h/tab-cursor :q) $value))))] (is (str/includes? out "evt.key === \"Enter\"")) (is (str/includes? out "@hyperAction('a_t_1', {value:evt.target.value})"))))))) + +(deftest test-client-param-with-statements + ;; An h/expr with a `;` returns through __hyper_r, which only works as a whole + ;; handler. The param is registered only for this test (other tests list the + ;; defined params), so the forms using it are compiled with eval. + (let [js (->expr {:meta (or (.-metaKey evt) (.-ctrlKey evt))})] + (is (str/ends-with? js "return __hyper_r;")) + (.addMethod ^clojure.lang.MultiFn hyper.client-params/client-param '$test-mods + (fn [_] {:js js :key "testMods"})) + (try + (let [wrapped (str "(() => { " js " })()")] + (testing "an action passes it as an expression" + (let [app-state* (new-tab)] + (rendering app-state* + (is (= (str "@hyperAction('a_t_1', {testMods:" wrapped "})") + (:js (eval `(h/action (prn ~'$test-mods))))))))) + + (testing "an expression embeds it as an expression" + (is (str/includes? (eval `(->expr (.-meta ~'$test-mods))) (str wrapped ".meta"))))) + (finally + (remove-method hyper.client-params/client-param '$test-mods))))) From 23692571dcd92fd25f1050100ed31cbcca1377e7 Mon Sep 17 00:00:00 2001 From: Martin Kavalar Date: Wed, 4 Nov 2026 17:15:44 +0100 Subject: [PATCH 3/3] Keep server signal writes over an action's older copy An action brings the page's signals as they were when it was made. When the server wrote a signal after that (an upload landing, say), the action's copy overwrote it, and the client was never patched back. Signal patches are now numbered and the client sends the number of the last one it applied (hyperSignalSeq); a path the server wrote after that keeps the server's value, which is then patched to the client. --- src/hyper/server.clj | 63 +++++++++++++++++++++----------- src/hyper/signal.clj | 54 ++++++++++++++++++++++++++- test/hyper/action_queue_test.clj | 36 +++++++++++++++++- 3 files changed, 129 insertions(+), 24 deletions(-) diff --git a/src/hyper/server.clj b/src/hyper/server.clj index c13a8ee..09cb4ba 100644 --- a/src/hyper/server.clj +++ b/src/hyper/server.clj @@ -229,17 +229,21 @@ (defn- drain-client-signals! "Atomically remove and return this tab's client-reported signals together - with its current signal state. Returns [client-reported current-signals]." + with its current signal state, numbered as the next patch (see + `signal/advance-seq`). Returns [client-reported current-signals]." [app-state* tab-id] ;; Consumed, not kept — a stale report must not suppress a later server ;; write back to the same value. (let [[old new] (swap-vals! app-state* (fn [state] - (if (get-in state [:tabs tab-id :client-signals]) - (update-in state [:tabs tab-id] dissoc :client-signals) - state)))] + (if (contains? (:tabs state) tab-id) + (update-in state [:tabs tab-id] + #(-> % (dissoc :client-signals) signal/advance-seq)) + state))) + tab (get-in new [:tabs tab-id])] [(get-in old [:tabs tab-id :client-signals]) - (get-in new [:tabs tab-id :signals])])) + (when-let [signals (:signals tab)] + (signal/with-seq tab signals))])) (defn- -renderer-loop! "Render loop for a single tab, run inside the SSE response's @@ -687,19 +691,25 @@ (let [tab-id (:tab-id action-data) req-with-state (assoc req :hyper/app-state app-state* - :hyper/router (get @app-state* :router))] - ;; Sync client signal values into server state so the - ;; render loop can detect changes (e.g. when a user types - ;; into a data-bind input, the server needs to know the - ;; latest value for changed-signals diffing). Recording - ;; them under :client-signals too keeps the render loop - ;; from echoing them back as patches. + :hyper/router (get @app-state* :router)) + ;; Sync client signal values into server state so the + ;; render loop can detect changes (e.g. when a user types + ;; into a data-bind input, the server needs to know the + ;; latest value for changed-signals diffing). Recording + ;; them under :client-signals too keeps the render loop + ;; from echoing them back as patches. A path the server + ;; wrote after the client's last patch keeps the server's + ;; value, which is then patched to the client. + signals (if (and signals tab-id) + (-> (swap! app-state* update-in [:tabs tab-id] + (fn [tab] + (-> tab + (update :signals merge (signal/without-unseen-writes tab signals)) + (update :client-signals merge signals)))) + (get-in [:tabs tab-id]) + (signal/without-unseen-writes signals)) + signals)] (when (and signals tab-id) - (swap! app-state* update-in [:tabs tab-id] - (fn [tab] - (-> tab - (update :signals merge signals) - (update :client-signals merge signals)))) ;; Persist auto-commit optimistics before the action body runs, ;; so cursor reads in the action see the committed value. (signal/auto-commit! app-state* tab-id signals)) @@ -1073,7 +1083,7 @@ action({ Shared by page-handler and not-found-handler so both emit identical document scaffolding, differing only in `status` and `fallback-title` (the used when the result has no :title)." - [result {:keys [datastar-script open-when-hidden? base-path webkit-sse-shim? core-version tree-shake? squint-core-url] + [result {:keys [datastar-script open-when-hidden? base-path webkit-sse-shim? core-version tree-shake? squint-core-url signal-seq] :or {open-when-hidden? true base-path "" webkit-sse-shim? true}} @@ -1085,7 +1095,8 @@ action({ tree-shake? (assoc :data-hyper-squint-version core-version) (:url result) (assoc :data-hyper-url (:url result)) (:render-version result) (assoc :data-hyper-render-version (:render-version result)) - sig-attrs (merge sig-attrs)) + sig-attrs (merge sig-attrs) + signal-seq (assoc (keyword (str "data-signals:" (name signal/seq-key))) signal-seq)) ;; WebKit/Safari fetch-streaming strand workaround: inject the ;; EventSource shim only for affected user agents, before the datastar ;; script so window.fetch is patched before datastar opens the stream. @@ -1126,6 +1137,16 @@ action({ :headers {"Content-Type" "text/html; charset=utf-8"} :body html})) +(defn- page-opts + "`opts` for `page-response` of a render of tab `tab-id`, with the signal + patch number its signals stand at." + [app-state* tab-id opts] + (assoc opts + :core-version (squint-core-version app-state*) + :tree-shake? (:tree-shake? @app-state*) + :signal-seq (-> (swap! app-state* update-in [:tabs tab-id] signal/advance-seq) + (get-in [:tabs tab-id :signal-seq] 0)))) + (defn page-handler "Wrap a page render function to provide full HTML response. Delegates rendering to render/render-tab so initial page loads share @@ -1150,7 +1171,7 @@ action({ ;; Ring response passthrough (e.g. a 302 redirect) (if (:status result) result - (page-response result (assoc opts :core-version (squint-core-version app-state*) :tree-shake? (:tree-shake? @app-state*)) req tab-id 200 "Hyper App"))))))) + (page-response result (page-opts app-state* tab-id opts) req tab-id 200 "Hyper App"))))))) (defn- not-found-handler "Reitit default-handler for unmatched routes: renders the configured @@ -1176,7 +1197,7 @@ action({ ;; Ring response passthrough (e.g. a redirect from render middleware) (if (:status result) result - (page-response result (assoc opts :core-version (squint-core-version app-state*) :tree-shake? (:tree-shake? @app-state*)) req tab-id 404 "Not Found")))))) + (page-response result (page-opts app-state* tab-id opts) req tab-id 404 "Not Found")))))) (defn- components-js-handler "Serve the assembled client-components ES module bundle. diff --git a/src/hyper/signal.clj b/src/hyper/signal.clj index 0285281..609b7df 100644 --- a/src/hyper/signal.clj +++ b/src/hyper/signal.clj @@ -83,6 +83,58 @@ (coll? v) (str "[" (str/join ", " (map clj->js-literal v)) "]") :else (str "'" (utils/escape-js-string (str v)) "'"))) +;; --------------------------------------------------------------------------- +;; Server writes vs. the client's copy +;; --------------------------------------------------------------------------- +;; An action brings the page's signals as they were when it was made, which +;; may predate a server write still on its way to the client. So the server +;; numbers its signal patches (sent as the `hyperSignalSeq` signal), notes for +;; each path it writes the first patch that can carry the write, and keeps its +;; own value at those paths over an action's from before that patch. +;; +;; Kept in tab state: +;; :signal-seq the number of the latest patch +;; :signal-writes {store-path patch-number} + +(def seq-key + "The signal holding the number of the latest signal patch the client applied." + :hyper-signal-seq) + +(defn write + "`tab` with signal `store-path` set to `v` by the server." + [tab store-path v] + (-> tab + (assoc-in (into [:signals] store-path) v) + (assoc-in [:signal-writes store-path] (inc (:signal-seq tab 0))))) + +(defn advance-seq + "`tab` with its signal seq moved past its writes when the current seq + doesn't cover them all, so the next patch carries the new number." + [tab] + (let [n (:signal-seq tab 0)] + (if (some #(> % n) (vals (:signal-writes tab))) + (assoc tab :signal-seq (inc n)) + tab))) + +(defn with-seq + "`signals` as the client should hold them: with `tab`'s signal seq." + [tab signals] + (assoc signals seq-key (:signal-seq tab 0))) + +(defn without-unseen-writes + "Client `signals` with `tab`'s value at every path the server wrote after + the last patch the client applied. Unchanged when they carry no patch + number." + [tab signals] + (if-let [seen (get signals seq-key)] + (reduce-kv (fn [signals path n] + (if (> n seen) + (assoc-in signals path (get-in tab (into [:signals] path))) + signals)) + (dissoc signals seq-key) + (:signal-writes tab)) + signals)) + ;; --------------------------------------------------------------------------- ;; Signal types ;; --------------------------------------------------------------------------- @@ -103,7 +155,7 @@ clojure.lang.IAtom (reset [_ newv] - (swap! app-state* assoc-in (into [:tabs tab-id :signals] store-path) newv) + (swap! app-state* update-in [:tabs tab-id] write store-path newv) newv) (swap [this f] diff --git a/test/hyper/action_queue_test.clj b/test/hyper/action_queue_test.clj index 027e20c..1953e99 100644 --- a/test/hyper/action_queue_test.clj +++ b/test/hyper/action_queue_test.clj @@ -35,11 +35,11 @@ (defn- queued "An action as @hyperAction queues it." - [{:keys [id seq v value]}] + [{:keys [id seq v value signals]}] {:id id :seq seq :v v - :signals "{}" + :signals (json/generate-string (or signals {})) :params (when value (json/generate-string {:value value}))}) (defn- rerender! [app*] @@ -106,6 +106,38 @@ (post-queue! handler v2 [(queued {:id id :seq 3 :v v2})]) (is (= 2 (get-in @app* [:tabs "T" :data :n])))))))) +(deftest test-server-writes-win-over-older-client-copies + (let [!status (atom nil) + [handler app*] (page-handler (fn [_] + (let [status (h/signal :status "idle")] + (reset! !status status) + [:div [:button {:data-on:click (h/action (reset! (h/tab-cursor :seen) @status))} + "look"]]))) + html (get-page handler) + v (render-version html) + id (action-id html "look") + page-seq (some-> (re-find #"data-signals:hyper-signal-seq=\"(\d+)\"" html) second parse-long) + drain! #(#'hyper.server/drain-client-signals! app* "T") + status #(get-in @app* [:tabs "T" :signals :status]) + seen #(get-in @app* [:tabs "T" :data :seen])] + (is (some? page-seq) "the page carries the signal patch number") + (testing "the server writes while an action made before seeing the write is on its way" + (reset! @!status "done") + (post-queue! handler v [(queued {:id id :seq 1 :v v :signals {:status "uploading" :hyperSignalSeq page-seq}})]) + (is (= "done" (seen)) "the action sees the server's value") + (is (= "done" (status)) "and the server keeps it") + (let [[client-reported current] (drain!)] + (is (= "uploading" (:status client-reported)) "the client is known to hold its own value") + (is (= "done" (:status current)) "so the server's is patched to it") + (testing "once the client applied that patch, its values count again" + (post-queue! handler v [(queued {:id id :seq 2 :v v :signals {:status "typed" :hyperSignalSeq (:hyper-signal-seq current)}})]) + (is (= "typed" (seen))) + (is (= "typed" (status)))))) + (testing "a client that sends no patch number is taken as is" + (reset! @!status "done") + (post-queue! handler v [(queued {:id id :seq 3 :v v :signals {:status "old"}})]) + (is (= "old" (seen)))))) + (deftest test-unknown-tab (let [[handler _] (page-handler (fn [_] [:div]))] (is (= 404 (:status (post-queue! handler nil [(queued {:id "a_T_1" :seq 1})]))))))