From a52fae0dae8e35072fa1e7852520ce1e3ad9210b Mon Sep 17 00:00:00 2001 From: Miguel de Benito Delgado Date: Fri, 30 Oct 2026 17:29:51 +0100 Subject: [PATCH] :recycle: Consolidate case declaration macros and helpers AI-assisted-by: deepseek-flash --- .../benches/render_wasm/declarations.clj | 84 ---- .../benches/render_wasm/declarations.cljc | 370 +++++++++++++++++ .../benches/render_wasm/declarations.cljs | 376 ------------------ .../benches/render_wasm/scenes/masks.cljs | 2 +- .../benches/render_wasm/scenes/paths.cljs | 2 +- .../benches/render_wasm/scenes/plus.cljs | 2 +- .../benches/render_wasm/scenes/rects.cljs | 2 +- .../render_wasm/contracts_test.cljs | 78 ++-- .../render_wasm/geometry_scenes_test.cljs | 6 +- 9 files changed, 414 insertions(+), 508 deletions(-) delete mode 100644 frontend/performance/benches/render_wasm/declarations.clj create mode 100644 frontend/performance/benches/render_wasm/declarations.cljc delete mode 100644 frontend/performance/benches/render_wasm/declarations.cljs diff --git a/frontend/performance/benches/render_wasm/declarations.clj b/frontend/performance/benches/render_wasm/declarations.clj deleted file mode 100644 index 9fdcb8443f..0000000000 --- a/frontend/performance/benches/render_wasm/declarations.clj +++ /dev/null @@ -1,84 +0,0 @@ -;; This Source Code Form is subject to the terms of the Mozilla Public -;; License, v. 2.0. If a copy of the MPL was not distributed with this -;; file, You can obtain one at http://mozilla.org/MPL/2.0/. -;; -;; Copyright (c) KALEIDOS SUBSIDIARY SL - -(ns benches.render-wasm.declarations - "Registration macros for renderer benchmark scenes and cases. - - The macros expand to calls to `register-scene!`/`register-case!` in - `declarations.cljs`. Registration is done there so it can be inspected and tested.") - -(defn- single-arg-vector? - "True when `form` is a vector holding one plain symbol." - [form] - (and (vector? form) - (= 1 (count form)) - (symbol? (first form)) - (not= '& (first form)))) - -(defn- check-arg-vector! - [macro id argv] - (when-not (single-arg-vector? argv) - (throw (ex-info (str macro " " id " requires one argument vector with one symbol") - {:type ::invalid-run-function - :id id - :form argv})))) - -(defmacro defscene - "Registers a scene and returns its id. - - - `id` (keyword) - - `opts` (`schema:scene`): maps `:description` and `:params-schema`. - - `argv` names one scene parameter symbol - - `body` builds the snapshot. - - Example: - - (defscene :rects opts [params] (scene params))" - [id opts argv & body] - (check-arg-vector! "defscene" id argv) - `(benches.render-wasm.declarations/register-scene! - (assoc ~opts :id ~id :ns ~(str *ns*) :build (fn ~argv ~@body)))) - -(defn- case-registration-form - [id scene opts run-fn] - (let [options (gensym "options")] - `(let [~options ~opts] - (when (contains? ~options :run!) - (throw (ex-info (str "defcase " ~id " requires its run function as the fourth argument") - {:type :benches.render-wasm.declarations/invalid-run-function - :id ~id}))) - (when (nil? ~scene) - (throw (ex-info (str "defcase " ~id " requires a :scene/case id") - {:type :benches.render-wasm.declarations/invalid-run-function - :id ~id - :form ~id}))) - (benches.render-wasm.declarations/register-case! - (assoc ~options :id ~id :scene ~scene :ns ~(str *ns*) - ~@(when run-fn [:run! run-fn])))))) - -(defn- scene-from-id - "Scene keyword derived from a `:scene/case` id. `nil` when `id` carries - no scene namespace." - [id] - (when-let [scene-ns (namespace id)] - (keyword scene-ns))) - -(defmacro defcase - "Registers a case for `scene` and returns its id. - - The scene comes from the namespace part of the `:scene/case` id. An - optional argument vector plus body becomes `:run!`; its argument name - is chosen by the caller. The no-body arity registers a case without `:run!`. - Ticket 14 will call it. Case collection omits it from descriptors. Example: - - (defcase :rects/pan options [context] (pan! context)) - - " - ([id opts] - (case-registration-form id (scene-from-id id) opts nil)) - ([id opts argv & body] - (check-arg-vector! "defcase" id argv) - (case-registration-form id (scene-from-id id) opts `(fn ~argv ~@body)))) diff --git a/frontend/performance/benches/render_wasm/declarations.cljc b/frontend/performance/benches/render_wasm/declarations.cljc new file mode 100644 index 0000000000..43189cd50b --- /dev/null +++ b/frontend/performance/benches/render_wasm/declarations.cljc @@ -0,0 +1,370 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS SUBSIDIARY SL + +(ns benches.render-wasm.declarations + "Declarations, registry and contracts for renderer benchmark scenes and cases. + + A scene declares an id, description, parameters schema and build function. + A case declares an id namespaced by its scene, parameters, view, context + policy, completion mode and optional operation identity and run function. + + Ordinary :require loads the declaration macros and runtime helpers. + Collection validates declarations and produces plain descriptors." + #?(:cljs (:require-macros + [app.common.exceptions :as ex] + [benches.render-wasm.declarations])) + #?(:clj (:require [app.common.schema :as-alias sm])) + #?(:cljs + (:require + [app.common.schema :as sm] + [app.common.transit :as t] + [clojure.string :as str]))) + +#?(:clj + (do + (defn- single-arg-vector? + "True when `form` is a vector holding one plain symbol." + [form] + (and (vector? form) + (= 1 (count form)) + (symbol? (first form)) + (not= '& (first form)))) + + (defn- check-arg-vector! + [macro id argv] + (when-not (single-arg-vector? argv) + (throw (ex-info (str macro " " id " requires one argument vector with one symbol") + {:type ::invalid-run-function + :id id + :form argv})))) + + (defmacro defscene + "Registers a scene and returns its id. + + `opts` supplies :description and :params-schema. `argv` names one scene + parameter symbol, and `body` builds the snapshot. + + Example: + + (defscene :rects opts [params] (scene params))" + [id opts argv & body] + (check-arg-vector! "defscene" id argv) + `(benches.render-wasm.declarations/register-scene! + (assoc ~opts :id ~id :ns ~(str *ns*) :build (fn ~argv ~@body)))) + + (defn- case-registration-form + [id scene opts run-fn] + (let [options (gensym "options")] + `(let [~options ~opts] + (when (contains? ~options :run!) + (throw (ex-info (str "defcase " ~id " requires its run function as the fourth argument") + {:type :benches.render-wasm.declarations/invalid-run-function + :id ~id}))) + (when (nil? ~scene) + (throw (ex-info (str "defcase " ~id " requires a :scene/case id") + {:type :benches.render-wasm.declarations/invalid-run-function + :id ~id + :form ~id}))) + (benches.render-wasm.declarations/register-case! + (assoc ~options :id ~id :scene ~scene :ns ~(str *ns*) + ~@(when run-fn [:run! run-fn])))))) + + (defn- scene-from-id + "Returns the scene keyword from a qualified case id, or nil." + [id] + (when-let [scene-ns (namespace id)] + (keyword scene-ns))) + + (defmacro defcase + "Registers a case and returns its id. + + The scene comes from the namespace part of the :scene/case id. An + optional argument vector and body supply the run function, which accepts + one execution context. Collection produces plain case descriptors. + + Example: + + (defcase :rects/pan options [context] (pan! context))" + ([id opts] + (case-registration-form id (scene-from-id id) opts nil)) + ([id opts argv & body] + (check-arg-vector! "defcase" id argv) + (case-registration-form id (scene-from-id id) opts `(fn ~argv ~@body)))))) + +#?(:cljs + (do + ;; Case execution context: + ;; :case - collected descriptor, including operation and completion + ;; :scene - scene snapshot {:objects ... :refs ...} + ;; :module - WASM module handle + ;; :view - prepared camera view + ;; :hooks - clock, scheduling, guard and renderer operations + ;; Case bodies return a measurement or a Promise of one. + + ;; Declarations and their transitive imports load in Node and the browser. + ;; Browser capabilities enter through the execution context; resource + ;; acquisition belongs to untimed preparation. Scenes keep their imports + ;; safe for Node discovery. + + (def default-viewport + "Default viewport dimensions and device pixel ratio for a case." + {:width 1920 :height 1080 :dpr 2}) + + (def schema:viewport + [:map {:closed true} + [:width {:optional true} ::sm/positive-safe-number] + [:height {:optional true} ::sm/positive-safe-number] + [:dpr {:optional true} ::sm/positive-safe-number]]) + + (def schema:view + "Camera placement with finite coordinates, positive scale and optional + viewport overrides." + [:map {:closed true} + [:scale ::sm/positive-safe-number] + [:x ::sm/safe-number] + [:y ::sm/safe-number] + [:viewport {:optional true} schema:viewport]]) + + (defn resolve-viewport + "Resolves a view's viewport overrides against the default viewport." + [view] + (merge default-viewport (:viewport view))) + + (def schema:scene + [:map {:closed true} + [:id simple-keyword?] + [:ns string?] + [:description string?] + [:params-schema vector?] + [:build fn?]]) + + (def schema:registered-case + [:map {:closed true} + [:id qualified-keyword?] + [:scene simple-keyword?] + [:ns string?] + [:params [:map]] + [:view schema:view] + [:context [:enum :fresh :reuse]] + [:completion {:optional true} [:enum :call :await :render-full]] + [:batch-size {:optional true} [:int {:min 1}]] + [:operation {:optional true} [:map]] + [:preparation {:optional true} [:map]] + [:run! {:optional true} fn?]]) + + (def schema:collected-case + [:map {:closed true} + [:id qualified-keyword?] + [:scene simple-keyword?] + [:scene-description string?] + [:scene-seed [:int {:min 0 :max 4294967295}]] + [:params [:map]] + [:view schema:view] + [:context [:enum :fresh :reuse]] + [:completion [:enum :call :await :render-full]] + [:batch-size [:int {:min 1}]] + [:preparation [:map]] + [:operation {:optional true} [:map]]]) + + (defonce registry + (atom {:scenes {} + :scene-order [] + :cases {} + :case-order []})) + + (defn- register-entry + [entries-key order-key kind duplicate-type {:keys [id ns] :as entry}] + (let [existing (get-in @registry [entries-key id])] + (when (and (some? existing) (not= ns (:ns existing))) + (throw (ex-info (str "duplicate " kind " id: " id) + {:type duplicate-type + :id id + :ns ns + :existing-ns (:ns existing)}))) + (swap! registry + (fn [reg] + (cond-> (assoc-in reg [entries-key id] entry) + (not (contains? (get reg entries-key) id)) + (update order-key conj id))))) + id) + + (defn register-scene! + "Registers a scene. The same id from the same namespace replaces the + entry in declaration order. Another namespace raises ::duplicate-scene." + [scene] + (register-entry :scenes :scene-order "scene" ::duplicate-scene scene)) + + (defn register-case! + "Registers a case. The same id from the same namespace replaces the + entry in declaration order. Another namespace raises ::duplicate-case." + [bench-case] + (register-entry :cases :case-order "case" ::duplicate-case bench-case)) + + (defn- unregister-entry + [entries-key order-key id] + (swap! registry + (fn [reg] + (-> reg + (update entries-key dissoc id) + (update order-key #(vec (remove #{id} %)))))) + id) + + (defn unregister-scene! + "Removes a scene registration and returns its id." + [id] + (unregister-entry :scenes :scene-order id)) + + (defn unregister-case! + "Removes a case registration and returns its id." + [id] + (unregister-entry :cases :case-order id)) + + (defn scenes + "Returns registered scenes in declaration order." + [] + (mapv (:scenes @registry) (:scene-order @registry))) + + (defn cases + "Returns registered cases in declaration order." + [] + (mapv (:cases @registry) (:case-order @registry))) + + (defn registered-scene + "Returns the full registration for a scene id." + [id] + (get-in @registry [:scenes id])) + + (defn registered-case + "Returns the full registration for a case id, including its run function." + [id] + (get-in @registry [:cases id])) + + (defn- check-params-schema! + [{:keys [id params-schema]}] + (try + (sm/schema params-schema) + (catch :default cause + (throw (ex-info (str "invalid params schema for scene " id) + {:type ::invalid-scene :id id} + cause))))) + + (defn- check-declaration + [schema declaration message error-type] + (when-not (sm/validate schema declaration) + (throw (ex-info (str message (:id declaration)) + {:type error-type + :id (:id declaration) + ::sm/explain (sm/explain schema declaration)}))) + declaration) + + (defn check-registered-scene! + "Validates a scene declaration and returns it unchanged." + [scene] + (check-params-schema! scene) + (check-declaration schema:scene scene "invalid scene declaration: " ::invalid-scene)) + + (defn check-registered-case! + "Validates a registered case declaration and returns it unchanged." + [bench-case] + (check-declaration schema:registered-case bench-case "invalid case declaration: " ::invalid-case)) + + (defn- check-param-keys! + "Rejects params keys that `canonical-params` cannot tell apart: only + simple keywords render distinctly by name." + [scene-id params] + (letfn [(check [value path] + (cond + (map? value) + (doseq [[k v] value] + (when-not (simple-keyword? k) + (throw (ex-info (str "seed identity requires simple keyword keys at " path) + {:type ::invalid-params + :scene scene-id + :path path + :key k}))) + (check v (str path "/" (name k)))) + + (vector? value) + (dorun (map-indexed (fn [index v] (check v (str path "[" index "]"))) value))))] + (check params ""))) + + (defn- canonical-params + "Stable textual identity of a params map: keys render sorted by name, + vectors keep their order, nested values render the same way. Map key + order is an accident of construction, so sorting keeps the identity on + the parameters themselves: equal parameters give the same seed whatever + their literal order. Keys render by name, so params maps use simple + keyword keys; derive-seed rejects anything else." + [params] + (letfn [(render [value] + (cond + (map? value) + (str "{" + (str/join "," + (map (fn [[k v]] (str (name k) ":" (render v))) + (sort-by (comp name key) value))) + "}") + + (vector? value) + (str "[" (str/join "," (map render value)) "]") + + :else + (pr-str value)))] + (render params))) + + (defn derive-seed + "FNV-1a 32-bit keyed hash of a case's parameter identity. + + Fowler-Noll-Vo, 32-bit, offset basis 2166136261, prime 16777619, hashed + over `\\0/`. A keyed hash, not + the scene PRNG: the scene's mulberry32 generator is seeded with the + result, and a sequential draw cannot substitute because it would couple + cases through collection order. Keyed by scene and params only, so the + seed does not depend on case name, collection order, operation body, + attempts or A/B feature selection. Params maps use simple keyword keys; + namespaced keywords and string keys cannot be told apart by name and make + derive-seed throw ::invalid-params." + [master-seed scene-id params] + (check-param-keys! scene-id params) + (let [text (str master-seed "\u0000" (name scene-id) "/" (canonical-params params))] + (loop [index 0 + seed 2166136261] + (if (< index (count text)) + (recur (inc index) + (unsigned-bit-shift-right + (js/Math.imul (bit-xor seed (.charCodeAt text index)) 16777619) + 0)) + seed)))) + + (defn transit-round-trips? + "True when `value` survives Transit encoding and decoding with the same + wire representation, including NaN and infinities." + [value] + (true? (ex/ignoring + (let [encoded (t/encode-str value)] + (= encoded (-> encoded t/decode-str t/encode-str)))))) + + (defn project-case + "Returns the case's descriptor fields with defaults for completion, + batch size and preparation." + [bench-case] + (-> bench-case + (select-keys [:id :scene :params :view :context :completion :batch-size + :operation :preparation]) + (update :completion #(or % :render-full)) + (update :batch-size #(or % 1)) + (update :preparation #(or % {})))) + + (defn check-collected-case + "Validates a collected case descriptor and its Transit representation, + returning the descriptor unchanged." + [projected] + (check-declaration schema:collected-case projected "invalid collected case: " ::invalid-case) + (when-not (transit-round-trips? projected) + (throw (ex-info (str "collected case does not survive the transit wire: " (:id projected)) + {:type ::non-serializable-case + :id (:id projected)}))) + projected))) diff --git a/frontend/performance/benches/render_wasm/declarations.cljs b/frontend/performance/benches/render_wasm/declarations.cljs deleted file mode 100644 index af455cc518..0000000000 --- a/frontend/performance/benches/render_wasm/declarations.cljs +++ /dev/null @@ -1,376 +0,0 @@ -;; This Source Code Form is subject to the terms of the Mozilla Public -;; License, v. 2.0. If a copy of the MPL was not distributed with this -;; file, You can obtain one at http://mozilla.org/MPL/2.0/. -;; -;; Copyright (c) KALEIDOS SUBSIDIARY SL - -(ns benches.render-wasm.declarations - "Registry and contract for renderer benchmark scenes and cases. - - Scene namespaces register themselves through the `defscene` and - `defcase` macros in `declarations.clj`. This namespace imports no browser or - renderer code. - - - A scene declares an id, a human description, a closed - parameters schema and a one-argument build function. - - A case declares an id namespaced by its scene, the scene, base parameters, - a view, a context policy, a completion mode and an optional operation - identity and run function. - - Collection validates every declaration, derives each scene seed and - returns plain data." - (:require-macros - [app.common.exceptions :as ex]) - (:require - [app.common.schema :as sm] - [app.common.transit :as t] - [clojure.string :as str])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Runtime contract -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; The browser executor supplies rtx to each compiled case body: -;; -;; :case the collected case descriptor (id, scene, params, view, -;; context, completion, batch-size, operation) -;; :scene the built scene snapshot {:objects ... :refs ...} -;; :module the WASM module handle, bound by the driver after init -;; :view the prepared full camera view -;; :hooks injected clock, scheduling, guard and renderer calls -;; -;; Standard bodies return a measurement or Promise of one. Ticket 14 extends -;; this runtime for general custom operations. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Node/browser dependency contract -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Scene declarations and bodies load in both Node and browser. The browser -;; executor calls the bodies. Their transitive imports must stay safe -;; for Node; removing :run! from descriptors does not isolate dependencies. -;; -;; If an operation needs a browser API/helper, keep that import in a browser -;; adapter and pass a narrow function or prepared resource through rtx. -;; Keep pure calculations in portable helpers. Define arguments, return or -;; promise completion, timing and cleanup ownership for each capability. -;; Resource acquisition normally belongs to untimed preparation. Reuse -;; existing capabilities before adding one; never import the adapter back -;; into a scene, even if the operation body is not called during discovery. -;; -;; This keeps metadata and bodies together with one declaration authority, -;; at the cost of portable imports and a maintained capability contract. -;; If unrelated services accumulate in rtx, revisit this design explicitly. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Schemas -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def default-viewport - "Viewport used when a case declares no `:viewport`: 1920x1080 at DPR 2. - Per-case config; run-level CLI overrides belong to ticket 11." - {:width 1920 :height 1080 :dpr 2}) - -(def schema:viewport - [:map {:closed true} - [:width {:optional true} ::sm/positive-safe-number] - [:height {:optional true} ::sm/positive-safe-number] - [:dpr {:optional true} ::sm/positive-safe-number]]) - -(def schema:view - "Camera placement plus optional viewport override. All numbers are finite: - unbounded `number?` accepts Infinity, which the renderer cannot use. Bounds - come from `::sm/safe-number`, whose min/max also rejects NaN and infinities." - [:map {:closed true} - [:scale ::sm/positive-safe-number] - [:x ::sm/safe-number] - [:y ::sm/safe-number] - [:viewport {:optional true} schema:viewport]]) - -(defn resolve-viewport - "Merges `default-viewport` under a case view's declared `:viewport`. - Collected descriptors keep the declared view; callers resolve at use so - existing cases need no edits." - [view] - (merge default-viewport (:viewport view))) - -(def schema:scene - [:map {:closed true} - [:id simple-keyword?] - [:ns string?] - [:description string?] - [:params-schema vector?] - [:build fn?]]) - -;; Ticket 14 owns operation argument schemas and collection-time validation. -;; Keep the reserved operation map open until that contract is defined. -(def schema:registered-case - [:map {:closed true} - [:id qualified-keyword?] - [:scene simple-keyword?] - [:ns string?] - [:params [:map]] - [:view schema:view] - [:context [:enum :fresh :reuse]] - [:completion {:optional true} [:enum :call :await :render-full]] - [:batch-size {:optional true} [:int {:min 1}]] - [:operation {:optional true} [:map]] - [:preparation {:optional true} [:map]] - [:run! {:optional true} fn?]]) - -(def schema:collected-case - [:map {:closed true} - [:id qualified-keyword?] - [:scene simple-keyword?] - [:scene-description string?] - [:scene-seed [:int {:min 0 :max 4294967295}]] - [:params [:map]] - [:view schema:view] - [:context [:enum :fresh :reuse]] - [:completion [:enum :call :await :render-full]] - [:batch-size [:int {:min 1}]] - [:preparation [:map]] - [:operation {:optional true} [:map]]]) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Registry -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defonce registry - (atom {:scenes {} - :scene-order [] - :cases {} - :case-order []})) - -(defn register-scene! - "Adds `scene` to the registry. Re-registering the same id from the same - namespace replaces the entry, so that namespace reload work. - The same id from another namespace throws ::duplicate-scene." - [{:keys [id ns] :as scene}] - (let [existing (get-in @registry [:scenes id])] - (when (and (some? existing) (not= ns (:ns existing))) - (throw (ex-info (str "duplicate scene id: " id) - {:type ::duplicate-scene - :id id - :ns ns - :existing-ns (:ns existing)}))) - (swap! registry - (fn [reg] - (if (contains? (:scenes reg) id) - (assoc-in reg [:scenes id] scene) - (-> reg - (assoc-in [:scenes id] scene) - (update :scene-order conj id)))))) - id) - -(defn register-case! - "Adds `bench-case` to the registry with the same replace/reject semantics - as register-scene!." - [{:keys [id ns] :as bench-case}] - (let [existing (get-in @registry [:cases id])] - (when (and (some? existing) (not= ns (:ns existing))) - (throw (ex-info (str "duplicate case id: " id) - {:type ::duplicate-case - :id id - :ns ns - :existing-ns (:ns existing)}))) - (swap! registry - (fn [reg] - (if (contains? (:cases reg) id) - (assoc-in reg [:cases id] bench-case) - (-> reg - (assoc-in [:cases id] bench-case) - (update :case-order conj id)))))) - id) - -(defn unregister-scene! - "Removes a scene registration. Tests use it to clean up synthetic scenes." - [id] - (swap! registry - (fn [reg] - (-> reg - (update :scenes dissoc id) - (update :scene-order #(vec (remove #{id} %)))))) - id) - -(defn unregister-case! - "Removes a case registration. Tests use it to clean up synthetic cases." - [id] - (swap! registry - (fn [reg] - (-> reg - (update :cases dissoc id) - (update :case-order #(vec (remove #{id} %)))))) - id) - -(defn scenes - "Registered scenes in declaration order." - [] - (mapv (:scenes @registry) (:scene-order @registry))) - -(defn cases - "Registered cases in declaration order." - [] - (mapv (:cases @registry) (:case-order @registry))) - -(defn registered-scene - "Full registered entry for a scene id." - [id] - (get-in @registry [:scenes id])) - -(defn registered-case - "Full case entry, including `:run!` when the case declares one." - [id] - (get-in @registry [:cases id])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Schema helpers -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- check-params-schema! - "Parses the scene's params schema with Penpot's registry, so a malformed - schema fails here with a typed error instead of raw invalid-schema - halfway through collection." - [{:keys [id params-schema]}] - (try - (sm/schema params-schema) - (catch :default cause - (throw (ex-info (str "invalid params schema for scene " id) - {:type ::invalid-scene - :id id} - cause))))) - -(defn check-registered-scene! - "Validates a scene declaration and returns it unchanged." - [scene] - (check-params-schema! scene) - (when-not (sm/validate schema:scene scene) - (throw (ex-info (str "invalid scene declaration: " (:id scene)) - {:type ::invalid-scene - :id (:id scene) - ::sm/explain (sm/explain schema:scene scene)}))) - scene) - -(defn check-registered-case! - "Validates a registered case declaration and returns it unchanged." - [bench-case] - (when-not (sm/validate schema:registered-case bench-case) - (throw (ex-info (str "invalid case declaration: " (:id bench-case)) - {:type ::invalid-case - :id (:id bench-case) - ::sm/explain (sm/explain schema:registered-case bench-case)}))) - bench-case) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Seed derivation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- check-param-keys! - "Rejects params keys that `canonical-params` cannot tell apart: only - simple keywords render distinctly by name." - [scene-id params] - (letfn [(check [value path] - (cond - (map? value) - (doseq [[k v] value] - (when-not (simple-keyword? k) - (throw (ex-info (str "seed identity requires simple keyword keys at " path) - {:type ::invalid-params - :scene scene-id - :path path - :key k}))) - (check v (str path "/" (name k)))) - - (vector? value) - (dorun (map-indexed (fn [index v] (check v (str path "[" index "]"))) value))))] - (check params ""))) - -(defn- canonical-params - "Stable textual identity of a params map: keys render sorted by name, - vectors keep their order, nested values render the same way. Map key - order is an accident of construction, so sorting keeps the identity on - the parameters themselves: equal parameters give the same seed whatever - their literal order. Keys render by name, so params maps use simple - keyword keys; derive-seed rejects anything else." - [params] - (letfn [(render [value] - (cond - (map? value) - (str "{" - (str/join "," - (map (fn [[k v]] (str (name k) ":" (render v))) - (sort-by (comp name key) value))) - "}") - - (vector? value) - (str "[" (str/join "," (map render value)) "]") - - :else - (pr-str value)))] - (render params))) - -(defn derive-seed - "FNV-1a 32-bit keyed hash of a case's parameter identity. - - Fowler-Noll-Vo, 32-bit, offset basis 2166136261, prime 16777619, hashed - over `\\0/`. A keyed hash, not - the scene PRNG: the scene's mulberry32 generator is seeded with the - result, and a sequential draw cannot substitute because it would couple - cases through collection order. Keyed by scene and params only, so the - seed does not depend on case name, collection order, operation body, - attempts or A/B feature selection. Params maps use simple keyword keys; - namespaced keywords and string keys cannot be told apart by name and make - derive-seed throw ::invalid-params." - [master-seed scene-id params] - (check-param-keys! scene-id params) - (let [text (str master-seed "\u0000" (name scene-id) "/" (canonical-params params))] - (loop [index 0 - seed 2166136261] - (if (< index (count text)) - (recur (inc index) - (unsigned-bit-shift-right - (js/Math.imul (bit-xor seed (.charCodeAt text index)) 16777619) - 0)) - seed)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Descriptor wire -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn transit-round-trips? - "True when `value` survives Transit encoding and decoding without changing - its wire representation. This permits NaN and infinities while still - rejecting values that Transit cannot encode." - [value] - (true? (ex/ignoring - (let [encoded (t/encode-str value)] - (= encoded (-> encoded t/decode-str t/encode-str)))))) - -(defn project-case - "Plain-data projection of a registered case: internal keys (`:ns`, `:run!`) - stripped, collection defaults applied." - [bench-case] - (-> bench-case - (select-keys [:id :scene :params :view :context :completion :batch-size - :operation :preparation]) - (update :completion #(or % :render-full)) - (update :batch-size #(or % 1)) - (update :preparation #(or % {})))) - -(defn check-collected-case - "Validates a collected case descriptor and returns it unchanged. - - Rejects anything that fails the schema and anything that does not survive - the transit descriptor wire: browser-side run functions must never reach - the runner." - [projected] - (when-not (sm/validate schema:collected-case projected) - (throw (ex-info (str "invalid collected case: " (:id projected)) - {:type ::invalid-case - :id (:id projected) - ::sm/explain (sm/explain schema:collected-case projected)}))) - (when-not (transit-round-trips? projected) - (throw (ex-info (str "collected case does not survive the transit wire: " (:id projected)) - {:type ::non-serializable-case - :id (:id projected)}))) - projected) diff --git a/frontend/performance/benches/render_wasm/scenes/masks.cljs b/frontend/performance/benches/render_wasm/scenes/masks.cljs index a6a41fe4ff..5eaa23e75d 100644 --- a/frontend/performance/benches/render_wasm/scenes/masks.cljs +++ b/frontend/performance/benches/render_wasm/scenes/masks.cljs @@ -8,7 +8,7 @@ "Fixed grid of masked groups with circle masks and ordered descendants." (:require [benches.render-wasm.builder :as sb] - [benches.render-wasm.declarations :as decl :include-macros true] + [benches.render-wasm.declarations :as decl] [benches.render-wasm.runtime.camera :as camera])) (def ^:const ^:private default-params diff --git a/frontend/performance/benches/render_wasm/scenes/paths.cljs b/frontend/performance/benches/render_wasm/scenes/paths.cljs index 411f2bd531..0cd50f6a5f 100644 --- a/frontend/performance/benches/render_wasm/scenes/paths.cljs +++ b/frontend/performance/benches/render_wasm/scenes/paths.cljs @@ -10,7 +10,7 @@ [app.common.schema :as sm] [app.common.types.path :as path] [benches.render-wasm.builder :as sb] - [benches.render-wasm.declarations :as decl :include-macros true] + [benches.render-wasm.declarations :as decl] [benches.render-wasm.random :refer [rng-int]] [benches.render-wasm.runtime.camera :as camera])) diff --git a/frontend/performance/benches/render_wasm/scenes/plus.cljs b/frontend/performance/benches/render_wasm/scenes/plus.cljs index 7f5ad0ec87..1752be892e 100644 --- a/frontend/performance/benches/render_wasm/scenes/plus.cljs +++ b/frontend/performance/benches/render_wasm/scenes/plus.cljs @@ -9,7 +9,7 @@ (:require [app.common.types.path :as path] [benches.render-wasm.builder :as sb] - [benches.render-wasm.declarations :as decl :include-macros true] + [benches.render-wasm.declarations :as decl] [benches.render-wasm.random :refer [rng-int]] [benches.render-wasm.runtime.camera :as camera])) diff --git a/frontend/performance/benches/render_wasm/scenes/rects.cljs b/frontend/performance/benches/render_wasm/scenes/rects.cljs index 3952b3045d..b7a3480e25 100644 --- a/frontend/performance/benches/render_wasm/scenes/rects.cljs +++ b/frontend/performance/benches/render_wasm/scenes/rects.cljs @@ -15,7 +15,7 @@ (:require [app.common.schema :as sm] [benches.render-wasm.builder :as sb] - [benches.render-wasm.declarations :as decl :include-macros true] + [benches.render-wasm.declarations :as decl] [benches.render-wasm.runtime.camera :as camera])) ;; This namespace is also loaded by Node discovery. Keep operation helpers diff --git a/frontend/test/performance_tests/render_wasm/contracts_test.cljs b/frontend/test/performance_tests/render_wasm/contracts_test.cljs index 23bec5ed4a..5d4d11272f 100644 --- a/frontend/test/performance_tests/render_wasm/contracts_test.cljs +++ b/frontend/test/performance_tests/render_wasm/contracts_test.cljs @@ -9,7 +9,7 @@ [app.common.schema :as sm] [app.common.transit :as transit] [benches.render-wasm.cases :as cases] - [benches.render-wasm.declarations :as decl :include-macros true] + [benches.render-wasm.declarations :as decl] [cljs.test :as t :include-macros true])) (defrecord Point [x y]) @@ -238,21 +238,23 @@ :params-schema [:map] :build (fn [params] params)})))))) -(t/deftest same-namespace-registration-replaces - (try - (decl/register-scene! {:id :contracts-replaced - :ns "contracts-test" - :description "first" - :params-schema [:map] - :build (fn [params] params)}) - (decl/register-scene! {:id :contracts-replaced - :ns "contracts-test" - :description "second" - :params-schema [:map] - :build (fn [params] params)}) - (t/is (= "second" (:description (decl/registered-scene :contracts-replaced)))) - (finally - (decl/unregister-scene! :contracts-replaced)))) +(t/deftest scene-replacement-preserves-order-and-unregister-removes + (let [ids [:contracts-first :contracts-middle :contracts-last] + scene {:ns "contracts-test" :description "first" + :params-schema [:map] :build identity} + get-scenes #(filterv (comp (set ids) :id) (decl/scenes))] + (try + (doseq [id ids] + (decl/register-scene! (assoc scene :id id))) + (decl/register-scene! (assoc scene :id :contracts-middle :description "second")) + (t/is (= ids (mapv :id (get-scenes)))) + (t/is (= ["first" "second" "first"] (mapv :description (get-scenes)))) + (decl/unregister-scene! :contracts-middle) + (t/is (= [:contracts-first :contracts-last] (mapv :id (get-scenes)))) + (t/is (nil? (decl/registered-scene :contracts-middle))) + (finally + (doseq [id ids] + (decl/unregister-scene! id)))))) (t/deftest duplicate-case-id-from-another-namespace-is-rejected (try @@ -383,31 +385,25 @@ (t/is (false? (decl/transit-round-trips? {:point point}))))) (t/deftest case-replacement-preserves-order-and-unregister-removes - (try - (decl/register-scene! {:id :contracts-replacecase - :ns "contracts-test" - :description "x" - :params-schema [:map] - :build (fn [params] params)}) - (decl/register-case! {:id :contracts-replacecase/case - :scene :contracts-replacecase - :ns "contracts-test" - :params {} - :view {:scale 1 :x 0 :y 0} - :context :fresh}) - (decl/register-case! {:id :contracts-replacecase/case - :scene :contracts-replacecase - :ns "contracts-test" - :params {} - :view {:scale 2 :x 0 :y 0} - :context :fresh}) - (t/is (= 1 (count (filter #(= :contracts-replacecase/case (:id %)) (decl/cases))))) - (t/is (= {:scale 2 :x 0 :y 0} (:view (decl/registered-case :contracts-replacecase/case)))) - (decl/unregister-case! :contracts-replacecase/case) - (t/is (nil? (decl/registered-case :contracts-replacecase/case))) - (finally - (decl/unregister-case! :contracts-replacecase/case) - (decl/unregister-scene! :contracts-replacecase)))) + (let [ids [:contracts-replacecase/first :contracts-replacecase/middle :contracts-replacecase/last] + bench-case {:scene :contracts-replacecase :ns "contracts-test" + :params {} :view {:scale 1 :x 0 :y 0} :context :fresh} + get-cases #(filterv (comp (set ids) :id) (decl/cases))] + (try + (decl/register-scene! {:id :contracts-replacecase :ns "contracts-test" + :description "x" :params-schema [:map] :build identity}) + (doseq [id ids] + (decl/register-case! (assoc bench-case :id id))) + (decl/register-case! (assoc bench-case :id :contracts-replacecase/middle :view {:scale 2 :x 0 :y 0})) + (t/is (= ids (mapv :id (get-cases)))) + (t/is (= [1 2 1] (mapv #(get-in % [:view :scale]) (get-cases)))) + (decl/unregister-case! :contracts-replacecase/middle) + (t/is (= [:contracts-replacecase/first :contracts-replacecase/last] (mapv :id (get-cases)))) + (t/is (nil? (decl/registered-case :contracts-replacecase/middle))) + (finally + (doseq [id ids] + (decl/unregister-case! id)) + (decl/unregister-scene! :contracts-replacecase))))) (t/deftest invalid-master-seed-is-rejected (doseq [seed [-1 4294967296 "42" nil 0.5 js/NaN js/Infinity js/-Infinity]] diff --git a/frontend/test/performance_tests/render_wasm/geometry_scenes_test.cljs b/frontend/test/performance_tests/render_wasm/geometry_scenes_test.cljs index 0457391dfd..58852a055b 100644 --- a/frontend/test/performance_tests/render_wasm/geometry_scenes_test.cljs +++ b/frontend/test/performance_tests/render_wasm/geometry_scenes_test.cljs @@ -20,7 +20,7 @@ (t/deftest curved-paths-use-canonical-content-and-stable-order (let [params {:count 12 :width 1920 :height 1080 :seed 42} - build (get-in @decl/registry [:scenes :paths :build]) + build (:build (decl/registered-scene :paths)) scene (build params) again (build params) shapes (helpers/children-of scene uuid/zero) @@ -37,7 +37,7 @@ (t/is (= scene (snapshot/validate! scene))))) (t/deftest plus-paths-have-two-crossing-open-lines - (let [build (get-in @decl/registry [:scenes :plus :build]) + (let [build (:build (decl/registered-scene :plus)) scene (build {:count 8 :width 1920 :height 1080 :seed 42}) first (first (helpers/children-of scene uuid/zero)) segments (vec (:content first)) @@ -55,7 +55,7 @@ (t/is (= scene (snapshot/validate! scene))))) (t/deftest mask-child-order-and-descendants-are-reachable - (let [build (get-in @decl/registry [:scenes :masks :build]) + (let [build (:build (decl/registered-scene :masks)) scene (build {:width 1920 :height 1080 :seed 42}) groups (helpers/children-of scene uuid/zero) group (first groups)