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/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/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..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 @@ -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/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/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..09cb4ba 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 @@ -228,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 @@ -616,12 +621,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 +639,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 +666,132 @@ 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. 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) + ;; 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 +1012,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` @@ -930,7 +1083,7 @@ 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}} @@ -941,7 +1094,9 @@ div-attrs (cond-> {:id "hyper-app"} tree-shake? (assoc :data-hyper-squint-version core-version) (:url result) (assoc :data-hyper-url (:url result)) - sig-attrs (merge sig-attrs)) + (:render-version result) (assoc :data-hyper-render-version (:render-version result)) + 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. @@ -962,6 +1117,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 @@ -981,6 +1137,16 @@ :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 @@ -1005,7 +1171,7 @@ ;; 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 @@ -1031,7 +1197,7 @@ ;; 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/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..1953e99 --- /dev/null +++ b/test/hyper/action_queue_test.clj @@ -0,0 +1,143 @@ +(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 signals]}] + {:id id + :seq seq + :v v + :signals (json/generate-string (or 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-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})])))))) 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 (= "<div id=\"async_t_1\" class=\"region\">:ready|:rows</div>" + (is (= "<div data-hyper-render-version=\"1\" id=\"async_t_1\" class=\"region\">:ready|:rows</div>" (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..ca8d2d6 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,25 @@ (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})"))))))) + +(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))))) 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