🚧 WIP Step 22 nicer macros

frontend/test/benches/render_wasm/declarations.clj

@@ -10,32 +10,38 @@
   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 `:version`, `:description` and
      `:params-schema`.
-   - `build` resolves to a one-argument function of the scene parameters."
-  [id opts build]
-  `(benches.render-wasm.declarations/register-scene!
-    (assoc ~opts :id ~id :ns ~(str *ns*) :build ~build)))
+   - `argv` names one scene parameter symbol
+   - `body` builds the snapshot.
 
-(defn- one-argument-fn-form?
-  "True for functions of arity 1"
-  [form]
-  (when (and (seq? form)
-             (contains? '#{fn fn* clojure.core/fn cljs.core/fn} (first form)))
-    (let [clauses (if (symbol? (second form)) (nnext form) (next form))
-          params  (cond
-                    (vector? (first clauses))
-                    (first clauses)
-                    (and (= 1 (count clauses))
-                         (seq? (first clauses)))
-                    (ffirst clauses))]
-      (and (vector? params)
-           (= 1 (count params))
-           (not= '& (first params))))))
+  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]
@@ -45,24 +51,35 @@
          (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.
 
-  An optional inline, one-argument function becomes `:run!`; its argument
-  name is chosen by the caller. Other function forms fail at expansion.
+  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 :rects options (fn [context] (pan! context)))"
-  ([id scene opts]
-   (case-registration-form id scene opts nil))
-  ([id scene opts run-fn]
-   (when-not (one-argument-fn-form? run-fn)
-     (throw (ex-info (str "defcase " id " requires an inline one-argument function")
-                     {:type ::invalid-run-function
-                      :id id
-                      :form run-fn})))
-   (case-registration-form id scene opts run-fn)))
+    (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))))

frontend/test/benches/render_wasm/scenes/masks.cljs

@@ -23,35 +23,38 @@
   {:version 1
    :description "Twenty-four circle masks with ordered striped descendants"
    :params-schema schema:params}
-  (fn [params]
-    (let [params (merge default-params params)]
-      (sb/scene {:seed (:seed params)
-                 :root {:x 0 :y 0 :width (:width params) :height (:height params)}}
-                (doseq [i (range 24)]
-                  (let [x (+ 25 (* 310 (mod i 6)))
-                        y (+ 25 (* 255 (quot i 6)))]
-                    (sb/group [:mask i] {:masked-group true}
-                              (sb/circle {:x x :y y :width 180 :height 180
-                                          :fills [{:fill-color "#ffffff"}]})
-                              (doseq [j (range 8)]
-                                (sb/rect {:x (+ x (* 28 j) -22)
-                                          :y (- y 12)
-                                          :width 25
-                                          :height 205
-                                          :fills [{:fill-color (if (even? j) "#1254b8" "#ff8b38")}]})))))))))
+  [params]
+  (let [params (merge default-params params)]
+    (sb/scene {:seed (:seed params)
+               :root {:x 0 :y 0 :width (:width params) :height (:height params)}}
+              (doseq [i (range 24)]
+                (let [x (+ 25 (* 310 (mod i 6)))
+                      y (+ 25 (* 255 (quot i 6)))]
+                  (sb/group [:mask i] {:masked-group true}
+                            (sb/circle {:x x :y y :width 180 :height 180
+                                        :fills [{:fill-color "#ffffff"}]})
+                            (doseq [j (range 8)]
+                              (sb/rect {:x (+ x (* 28 j) -22)
+                                        :y (- y 12)
+                                        :width 25
+                                        :height 205
+                                        :fills [{:fill-color (if (even? j) "#1254b8" "#ff8b38")}]}))))))))
 
 (def ^:const ^:private base-view {:scale 1 :x 0 :y 0})
 
-(decl/defcase :masks/load :masks
+(decl/defcase :masks/load
   {:params default-params :view base-view :context :fresh}
-  (fn [rtx] (camera/load! rtx)))
+  [rtx]
+  (camera/load! rtx))
 
-(decl/defcase :masks/pan :masks
+(decl/defcase :masks/pan
   {:params default-params :view base-view :context :reuse
    :operation {:steps 20 :dx 120 :dy 40 :settle-ms 100}}
-  (fn [rtx] (camera/pan! rtx)))
+  [rtx]
+  (camera/pan! rtx))
 
-(decl/defcase :masks/zoom :masks
+(decl/defcase :masks/zoom
   {:params default-params :view base-view :context :reuse
    :operation {:steps 20 :factor 1.6 :settle-ms 100}}
-  (fn [rtx] (camera/zoom! rtx)))
+  [rtx]
+  (camera/zoom! rtx))

frontend/test/benches/render_wasm/scenes/paths.cljs

@@ -49,27 +49,30 @@
   {:version 1
    :description "Curved paths"
    :params-schema schema:params}
-  (fn [params]
-    (let [params (merge default-params params)]
-      (sb/scene {:seed (:seed params)
-                 :root {:x 0 :y 0 :width (:width params) :height (:height params)}
-                 :defaults {:path {:content (curved-content params)
-                                   :fills (sb/gen-vector (sb/gen-fill))
-                                   :strokes (sb/gen-vector (sb/gen-stroke 3))}}}
-                (doseq [_ (range (:count params))]
-                  (sb/path))))))
+  [params]
+  (let [params (merge default-params params)]
+    (sb/scene {:seed (:seed params)
+               :root {:x 0 :y 0 :width (:width params) :height (:height params)}
+               :defaults {:path {:content (curved-content params)
+                                 :fills (sb/gen-vector (sb/gen-fill))
+                                 :strokes (sb/gen-vector (sb/gen-stroke 3))}}}
+              (doseq [_ (range (:count params))]
+                (sb/path)))))
 
 
-(decl/defcase :paths/load :paths
+(decl/defcase :paths/load
   {:params default-params :view base-view :context :fresh}
-  (fn [rtx] (camera/load! rtx)))
+  [rtx]
+  (camera/load! rtx))
 
-(decl/defcase :paths/pan :paths
+(decl/defcase :paths/pan
   {:params default-params :view base-view :context :reuse
    :operation {:steps 20 :dx 160 :dy 40 :settle-ms 100}}
-  (fn [rtx] (camera/pan! rtx)))
+  [rtx]
+  (camera/pan! rtx))
 
-(decl/defcase :paths/zoom :paths
+(decl/defcase :paths/zoom
   {:params default-params :view base-view :context :reuse
    :operation {:steps 20 :factor 1.5 :settle-ms 100}}
-  (fn [rtx] (camera/zoom! rtx)))
+  [rtx]
+  (camera/zoom! rtx))

frontend/test/benches/render_wasm/scenes/plus.cljs

@@ -38,29 +38,31 @@
   {:version 1
    :description "Plus signs made of two open line subpaths"
    :params-schema schema:params}
-  (fn build
-    [params]
-    (let [params (merge default-params params)]
-      (sb/scene {:seed (:seed params)
-                 :root {:x 0 :y 0 :width (:width params) :height (:height params)}
-                 :defaults {:path {:content (plus-content params)
-                                   :fills []
-                                   :strokes (sb/gen-vector (sb/gen-stroke 4))}}}
-                (doseq [_ (range (:count params))]
-                  (sb/path))))))
+  [params]
+  (let [params (merge default-params params)]
+    (sb/scene {:seed (:seed params)
+               :root {:x 0 :y 0 :width (:width params) :height (:height params)}
+               :defaults {:path {:content (plus-content params)
+                                 :fills []
+                                 :strokes (sb/gen-vector (sb/gen-stroke 4))}}}
+              (doseq [_ (range (:count params))]
+                (sb/path)))))
 
 (def ^:private base-view {:scale 1 :x 0 :y 0})
 
-(decl/defcase :plus/load :plus
+(decl/defcase :plus/load
   {:params default-params :view base-view :context :fresh}
-  (fn [rtx] (camera/load! rtx)))
+  [rtx]
+  (camera/load! rtx))
 
-(decl/defcase :plus/pan :plus
+(decl/defcase :plus/pan
   {:params default-params :view base-view :context :reuse
    :operation {:steps 20 :dx 140 :dy 60 :settle-ms 100}}
-  (fn [rtx] (camera/pan! rtx)))
+  [rtx]
+  (camera/pan! rtx))
 
-(decl/defcase :plus/zoom :plus
+(decl/defcase :plus/zoom
   {:params default-params :view base-view :context :reuse
    :operation {:steps 20 :factor 1.4 :settle-ms 100}}
-  (fn [rtx] (camera/zoom! rtx)))
+  [rtx]
+  (camera/zoom! rtx))

frontend/test/benches/render_wasm/scenes/rects.cljs

@@ -9,7 +9,7 @@
 
   Distributes rectangles over the canvas with varied sizes, translucent
   fills and centered strokes, all drawn from the scope's seeded generator.
-  `build` produces the scene snapshot; `defscene` and `defcase` declare
+  The `defscene` body produces the scene snapshot; `defcase` declares
   the scene and its standard cases. The three cases share parameters, so
   they render the same scene."
   (:require
@@ -57,9 +57,10 @@
    :r3      (sb/gen-int 0 24)
    :r4      (sb/gen-int 0 24)})
 
-(defn build
-  "Builds the seeded rectangle scene. `params` requires `:seed`; the other
-  keys default to the standard case parameters."
+(decl/defscene :rects
+  {:version 1
+   :description "Seeded rectangles with translucent fills and centered strokes"
+   :params-schema schema:params}
   [params]
   (let [params (merge default-params params)]
     (sb/scene {:seed (:seed params)
@@ -71,33 +72,30 @@
               (doseq [_ (range (:count params))]
                 (sb/rect)))))
 
-(decl/defscene :rects
-  {:version 1
-   :description "Seeded rectangles with translucent fills and centered strokes"
-   :params-schema schema:params}
-  build)
-
 (def ^:private base-view
   {:scale 1 :x 0 :y 0})
 
-(decl/defcase :rects/load :rects
+(decl/defcase :rects/load
   {:params default-params
    :view base-view
    :context :fresh}
-  (fn [rtx] (camera/load! rtx)))
+  [rtx]
+  (camera/load! rtx))
 
-(decl/defcase :rects/pan :rects
+(decl/defcase :rects/pan
   {:params default-params
    :view base-view
    :context :reuse
    :completion :render-full
    :operation {:steps 20 :dx 200 :dy 0 :settle-ms 100}}
-  (fn [rtx] (camera/pan! rtx)))
+  [rtx]
+  (camera/pan! rtx))
 
-(decl/defcase :rects/zoom :rects
+(decl/defcase :rects/zoom
   {:params default-params
    :view base-view
    :context :reuse
    :completion :render-full
    :operation {:steps 20 :factor 1.5 :settle-ms 100}}
-  (fn [rtx] (camera/zoom! rtx)))
+  [rtx]
+  (camera/zoom! rtx))

frontend/test/frontend_tests/benches/builder_test.cljs

@@ -8,14 +8,15 @@
   (:require
    [app.common.uuid :as uuid]
    [benches.render-wasm.builder :as b :include-macros true]
-   [benches.render-wasm.scenes.rects :as rects]
+   [benches.render-wasm.declarations :as decl]
+   [benches.render-wasm.scenes.rects]
    [benches.render-wasm.snapshot :as common]
    [cljs.test :as t :include-macros true]
    [frontend-tests.benches.test-helpers :as helpers]))
 
 (defn- build
   ([] (build {}))
-  ([params] (rects/build (merge {:seed 42 :count 5} params))))
+  ([params] ((:build (decl/registered-scene :rects)) (merge {:seed 42 :count 5} params))))
 
 (defn- add-tile
   "Helper defined outside a scene scope, called from inside one."
@@ -27,7 +28,7 @@
   (t/is (not= (build) (build {:seed 43}))))
 
 (t/deftest rectangle-workload-keeps-default-count
-  (let [instance (rects/build {:seed 42})
+  (let [instance (build {:seed 42 :count 1000})
         rects    (helpers/root-shapes instance)]
     (t/is (= 1000 (count rects)))
     (t/is (< 1 (count (distinct (map :x rects)))))))

frontend/test/frontend_tests/benches/contracts_test.cljs

@@ -26,13 +26,15 @@
   {:version 1
    :description "Synthetic scene for contract tests"
    :params-schema [:map {:closed true}]}
-  (fn [params] params))
+  [params]
+  params)
 
-(decl/defcase :contracts-scene/case :contracts-scene
+(decl/defcase :contracts-scene/case
   {:params {}
    :view {:scale 1 :x 0 :y 0}
    :context :fresh}
-  (fn [ctx] (touch! ctx)))
+  [ctx]
+  (touch! ctx))
 
 (defn- failure-data
   [f]
@@ -431,6 +433,14 @@
 (t/deftest defcase-rejects-run-function-in-options
   (t/is (= :benches.render-wasm.declarations/invalid-run-function
            (:type (failure-data
-                   #(decl/defcase :contracts-scene/unchecked :contracts-scene
+                   #(decl/defcase :contracts-scene/unchecked
                       {:run! (fn [x y] [x y])})))))
   (t/is (nil? (decl/registered-case :contracts-scene/unchecked))))
+
+(t/deftest defcase-rejects-unqualified-id
+  (t/is (= :benches.render-wasm.declarations/invalid-run-function
+           (:type (failure-data
+                   #(decl/defcase :bare
+                      {:params {}
+                       :view {:scale 1 :x 0 :y 0}
+                       :context :fresh}))))))

frontend/test/frontend_tests/benches/geometry_scenes_test.cljs

@@ -11,9 +11,9 @@
    [benches.render-wasm.cases :as cases]
    [benches.render-wasm.declarations :as decl]
    ;; These 3 register the scenes, do not remove
-   [benches.render-wasm.scenes.masks :as masks]
-   [benches.render-wasm.scenes.paths :as paths]
-   [benches.render-wasm.scenes.plus :as plus]
+   [benches.render-wasm.scenes.masks]
+   [benches.render-wasm.scenes.paths]
+   [benches.render-wasm.scenes.plus]
    [benches.render-wasm.snapshot :as common]
    [cljs.test :as t :include-macros true]
    [frontend-tests.benches.test-helpers :as helpers]))