mirror of
https://github.com/penpot/penpot.git
synced 2026-10-31 23:10:31 +00:00
♻️ Consolidate case declaration macros and helpers
AI-assisted-by: deepseek-flash
This commit is contained in:
Miguel de Benito Delgado
parent
18ef4f96b5
commit
a52fae0dae
@ -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))))
|
||||
370
frontend/performance/benches/render_wasm/declarations.cljc
Normal file
370
frontend/performance/benches/render_wasm/declarations.cljc
Normal file
@ -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 `<master-seed>\\0<scene-id>/<canonical params>`. 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)))
|
||||
@ -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 `<master-seed>\\0<scene-id>/<canonical params>`. 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)
|
||||
@ -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
|
||||
|
||||
@ -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]))
|
||||
|
||||
|
||||
@ -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]))
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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]]
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user