revert resolve-alias back to 3 args; impl apply-normalized fn

onionpancakes · Feb 22, 2024 · 1c5bbb4 · 1c5bbb4
1 parent 48be865
commit 1c5bbb4
Show file tree

Hide file tree

Showing 7 changed files with 104 additions and 71 deletions.
diff --git a/README.md b/README.md
@@ -333,20 +333,18 @@ Only **global keywords** and **strings** are interpreted as attribute keys. Ever
 
 Alias elements are user defined elements. They resolve to other elements through the `resolve-alias` multimethod. They must begin with **namespaced keywords**.
 
-Define an alias element by extending the `resolve-alias` multimethod with a namespaced keyword and a function implementation receiving 4 arguments: metadata map, tag keyword, attributes map, and content vector.
+Define an alias element by extending the `resolve-alias` multimethod with a namespaced keyword and a function implementation receiving 3 arguments: tag keyword, attributes map, and content vector.
 
 Since namespaced keywords are not interpreted as attributes, they can be used as arguments for alias elements.
 
-Attribute map received (3rd arg) contains the merged attributes from the alias element, including `id` and `class` from the element tag. By placing the alias element's attribute map as the attribute map of a resolved element, the attributes transfers seamlessly between the two.
+Attribute map received (2rd arg) contains the merged attributes from the alias element, including `id` and `class` from the element tag. By placing the alias element's attribute map as the attribute map of a resolved element, the attributes transfers seamlessly between the two.
 
-Content subvector received (4th arg) contains the content of the alias element. It has metadata `{::c/content true}` to avoid being interpreted as an element.
-
-The metadata and tag (1st and 2nd arg) are not needed for normal use case but is provided for advanced tinkering.
+Content subvector received (3rd arg) contains the content of the alias element. It has metadata `{::c/content true}` to avoid being interpreted as an element.
 
 ```clojure
 ;; Capitalized name optional, just to make it distinctive.
 (defmethod c/resolve-alias ::Layout
-  [_ _ {:layout/keys [title] :as attrs} content]
+  [_ {:layout/keys [title] :as attrs} content]
   [:div.layout attrs ; Merge attributes
    [:h1 title]
    [:main content]
@@ -460,7 +458,7 @@ Slap a `cc/compile` wherever speed is needed! Then call `c/html` like normal to
 
 ;; In aliases
 (defmethod c/resolve-alias ::MyElement
-  [_ _ attrs content]
+  [_ attrs content]
   (cc/compile
     [:div
      [:p attrs content]]))
@@ -605,7 +603,7 @@ Type hinting the argument or bindings also works.
 ```clojure
 ;; Should work!
 (defmethod c/resolve-alias ::CompileWithAttrs
-  [_ _ ^java.util.Map attrs content]
+  [_ ^java.util.Map attrs content]
   (cc/compile [:div attrs content]))
 
 (let [^java.util.Map attrs {:foo "bar"}]
@@ -630,7 +628,7 @@ Certain functions in `clojure.core` which returns maps are consider as attribute
 ```clojure
 ;; Useful in aliases when merging attrs.
 (defmethod c/resolve-alias ::AliasWithAttrsMerge
-  [_ _ attrs content]
+  [_ attrs content]
   (cc/compile
     [:div (merge {:foo "bar"} attrs)
       content]))
@@ -667,7 +665,7 @@ Alias elements are implemented as `c/resolve-alias` function calls. As a result,
 
 ```clojure
 (defmethod c/resolve-alias ::FooComp
-  [_ _ attrs content]
+  [_ attrs content]
   [:div attrs content])
 
 (pprint (clojure.walk/macroexpand-all
@@ -752,7 +750,7 @@ Runtime compilation is similar to calling `c/html` with a few key differences:
   (java.time.LocalTime/now))
 
 (defmethod c/resolve-alias ::CurrentTime
-  [_ _ _ _]
+  [_ _ _]
   [:p "Current time is: " current-time])
 
 (def static-page

diff --git a/dev/bench/chassis.clj b/dev/bench/chassis.clj
@@ -3,7 +3,7 @@
             [dev.onionpancakes.chassis.compiler :as cc]))
 
 (defmethod c/resolve-alias ::Item
-  [_ _ {item ::item :as attrs} content]
+  [_ {item ::item :as attrs} content]
   [:div.item (merge {:id    (:uuid item)
                      :class (:type item)} attrs)
    [:h2 (:name item)]
@@ -14,7 +14,7 @@
    [:p (:text item)]])
 
 (defmethod c/resolve-alias ::ItemCompiled
-  [_ _ {item ::item :as attrs} content]
+  [_ {item ::item :as attrs} content]
   (cc/compile
    [:div.item (merge {:id    (:uuid item)
                       :class (:type item)} attrs)
@@ -26,7 +26,7 @@
     [:p (:text item)]]))
 
 (defmethod c/resolve-alias ::ItemCompiledUnambig
-  [_ _ {item ::item :as attrs} content]
+  [_ {item ::item :as attrs} content]
   (cc/compile
    [:div.item (merge {:id    (:uuid item)
                       :class (:type item)} attrs)
@@ -38,7 +38,7 @@
     [:p nil (:text item)]]))
 
 (defmethod c/resolve-alias ::Layout
-  [_ _ {title ::title :as attrs} content]
+  [_ {title ::title :as attrs} content]
   [:html {:lang "en"}
    [:head
     [:link {:href "/foobar1" :rel "stylesheet"}]
@@ -53,7 +53,7 @@
     [:footer "Footer"]]])
 
 (defmethod c/resolve-alias ::LayoutCompiled
-  [_ _ {title ::title :as attrs} content]
+  [_ {title ::title :as attrs} content]
   (cc/compile
    [:html {:lang "en"}
     [:head
@@ -69,7 +69,7 @@
      [:footer "Footer"]]]))
 
 (defmethod c/resolve-alias ::LayoutCompiledUnambig
-  [_ _ {title ::title :as attrs} content]
+  [_ {title ::title :as attrs} content]
   (cc/compile
    [:html {:lang "en"}
     [:head

diff --git a/dev/user.clj b/dev/user.clj
@@ -33,16 +33,16 @@
             [clojure.walk :refer [macroexpand-all]]))
 
 (defmethod c/resolve-alias ::Foo
-  [_ _ attrs content]
+  [_ attrs content]
   [:div.foo attrs content])
 
 (defmethod c/resolve-alias ::Fooc
-  [_ _ ^java.util.Map attrs content]
+  [_ ^java.util.Map attrs content]
   (cc/compile
    [:div.fooc attrs content]))
 
 (defmethod c/resolve-alias ::Layoutc
-  [_ _ attrs content]
+  [_ attrs content]
   (cc/compile
    [:html
     [:head

diff --git a/src/dev/onionpancakes/chassis/compiler.clj b/src/dev/onionpancakes/chassis/compiler.clj
@@ -331,10 +331,11 @@
         tag        (.-tag opening)
         head-id    (.-head-id opening)
         head-class (.-head-class opening)]
-    [`(c/resolve-alias ~metadata
-                       ~tag
-                       ~(c/make-head-attrs head-id head-class attrs)
-                       (compile* ~(c/content-subvec elem 2)))]))
+    [`(c/resolve-alias-with-meta
+       ~metadata
+       ~tag
+       ~(c/make-head-attrs head-id head-class attrs)
+       (compile* ~(c/content-subvec elem 2)))]))
 
 (defn compilable-alias-element-children-attrs-present
   [elem]
@@ -345,12 +346,13 @@
         tag        (.-tag opening)
         head-id    (.-head-id opening)
         head-class (.-head-class opening)]
-    [`(c/resolve-alias ~metadata
-                       ~tag
-                       ~(if (or head-id head-class)
-                         `(c/make-head-attrs ~head-id ~head-class ~attrs)
-                         attrs)
-                       (compile* ~(c/content-subvec elem 2)))]))
+    [`(c/resolve-alias-with-meta
+       ~metadata
+       ~tag
+       ~(if (or head-id head-class)
+          `(c/make-head-attrs ~head-id ~head-class ~attrs)
+          attrs)
+       (compile* ~(c/content-subvec elem 2)))]))
 
 (defn compilable-alias-element-children-attrs-absent
   [elem]
@@ -360,10 +362,11 @@
         tag        (.-tag opening)
         head-id    (.-head-id opening)
         head-class (.-head-class opening)]
-    [`(c/resolve-alias ~metadata
-                       ~tag
-                       ~(c/make-head-attrs head-id head-class)
-                       (compile* ~(c/content-subvec elem 1)))]))
+    [`(c/resolve-alias-with-meta
+       ~metadata
+       ~tag
+       ~(c/make-head-attrs head-id head-class)
+       (compile* ~(c/content-subvec elem 1)))]))
 
 (defn compilable-alias-element-children-attrs-ambig
   [elem]
@@ -377,16 +380,18 @@
         attrs-sym  (gensym "attrs")]
     [`(let [~attrs-sym ~attrs]
         (if (c/attrs? ~attrs-sym)
-          (c/resolve-alias ~metadata
-                           ~tag
-                           ~(if (or head-id head-class)
-                              `(c/make-head-attrs ~head-id ~head-class ~attrs-sym)
-                              attrs-sym)
-                           (compile* ~(c/content-subvec elem 2)))
-          (c/resolve-alias ~metadata
-                           ~tag
-                           ~(c/make-head-attrs head-id head-class)
-                           (compile* ~[attrs-sym (c/content-subvec elem 2)]))))]))
+          (c/resolve-alias-with-meta
+           ~metadata
+           ~tag
+           ~(if (or head-id head-class)
+              `(c/make-head-attrs ~head-id ~head-class ~attrs-sym)
+              attrs-sym)
+           (compile* ~(c/content-subvec elem 2)))
+          (c/resolve-alias-with-meta
+           ~metadata
+           ~tag
+           ~(c/make-head-attrs head-id head-class)
+           (compile* ~[attrs-sym (c/content-subvec elem 2)]))))]))
 
 (defn compilable-alias-element-children
   [elem]

diff --git a/src/dev/onionpancakes/chassis/core.clj b/src/dev/onionpancakes/chassis/core.clj
@@ -15,8 +15,9 @@
   (^Iterable children [this] "Returns children as Iterable."))
 
 (defmulti resolve-alias
-  "Resolves alias given metadata, tag, attrs map, and content vector, returning the resolved Node."
-  (fn [_ tag _ _] tag))
+  "Resolves alias given tag, attrs map, and content vector,
+  returning the resolved Node."
+  (fn [tag _ _] tag))
 
 ;; Implementation notes:
 ;; - HTML serialization is implemented as depth first search (DFS) traversal over Node.
@@ -928,8 +929,8 @@
          (assoc attrs :class head-class))
        attrs))))
 
-(defn resolve-alias-element-attrs
-  [^clojure.lang.IPersistentVector elem]
+(defn apply-normalized-with-meta-attrs*
+  [f ^clojure.lang.IPersistentVector elem]
   (let [metadata     (meta elem)
         head         (.nth elem 0)
         attrs        (.nth elem 1)
@@ -942,10 +943,10 @@
                        ;; Copy java map into clj map.
                        (make-head-attrs head-id head-class (into {} attrs)))
         content      (content-subvec elem 2)]
-    (resolve-alias metadata tag merged-attrs content)))
+    (f metadata tag merged-attrs content)))
 
-(defn resolve-alias-element
-  [^clojure.lang.IPersistentVector elem]
+(defn apply-normalized-with-meta*
+  [f ^clojure.lang.IPersistentVector elem]
   (let [metadata   (meta elem)
         head       (.nth elem 0)
         opening    (make-opening-tag metadata head nil)
@@ -954,14 +955,42 @@
         head-class (.-head-class opening)
         attrs      (make-head-attrs head-id head-class)
         content    (content-subvec elem 1)]
-    (resolve-alias metadata tag attrs content)))
+    (f metadata tag attrs content)))
+
+(defn apply-normalized-with-meta
+  [f elem]
+  (if (has-attrs? elem)
+    (apply-normalized-with-meta-attrs* f elem)
+    (apply-normalized-with-meta* f elem)))
+
+(defn merge-meta
+  [obj metadata]
+  (if (instance? clojure.lang.IObj obj)
+    (with-meta obj (merge (meta obj) metadata))
+    obj))
+
+(defn resolve-with-meta-fn
+  [f]
+  (fn [metadata tag attrs content]
+    (-> (f tag attrs content)
+        (merge-meta metadata))))
+
+(defn apply-normalized
+  [f elem]
+  (apply-normalized-with-meta (resolve-with-meta-fn f) elem))
+
+(defn resolve-alias-with-meta
+  [metadata tag attrs content]
+  (-> (resolve-alias tag attrs content)
+      (merge-meta metadata)))
+
+(defn resolve-alias-element
+  [elem]
+  (apply-normalized-with-meta resolve-alias-with-meta elem))
 
 (defn alias-element-children
   [elem]
-  ;; Note: alias elements adds an additional depth to the search stack.
-  (if (has-attrs? elem)
-    [(resolve-alias-element-attrs elem)]
-    [(resolve-alias-element elem)]))
+  [(resolve-alias-element elem)])
 
 ;; Normal element
 

diff --git a/test/dev/onionpancakes/chassis/tests/test_compiler.clj b/test/dev/onionpancakes/chassis/tests/test_compiler.clj
@@ -28,7 +28,7 @@
   `(example-elem-macro ~arg))
 
 (defmethod c/resolve-alias ::Foo
-  [_ _ attrs content]
+  [_ attrs content]
   [:p.alias attrs content])
 
 (deftest test-compile
@@ -118,7 +118,7 @@
   (let [^java.util.Map attrs nil]
     (cc/compile [:div attrs "foobar"]))
   (defmethod c/resolve-alias ::ReflectiveAttrsAlias
-    [_ _ ^java.util.Map attrs content]
+    [_ ^java.util.Map attrs content]
     (cc/compile [:div.reflective-alias-attrs attrs content]))
   ;; Type hinted invocation
   (cc/compile [:div ^java.util.Map (:foo {:foo {}}) "foobar"])
@@ -157,7 +157,7 @@
 ;; Alias
 
 (defmethod c/resolve-alias ::TestAliasContent
-  [_ _ _ content]
+  [_ _ content]
   (is (vector? content))
   (is (::c/content (meta content)))
   [:p content])

diff --git a/test/dev/onionpancakes/chassis/tests/test_core.clj b/test/dev/onionpancakes/chassis/tests/test_core.clj
@@ -409,24 +409,20 @@
     (is (= @counter 1))))
 
 (defmethod c/resolve-alias ::Foo
-  [_ _ attrs content]
+  [_ attrs content]
   [:div.foo attrs content])
 
 (defmethod c/resolve-alias ::Bar
-  [_ _ attrs content]
+  [_ attrs content]
   [:span.bar attrs content])
 
 (defmethod c/resolve-alias ::Recursive
-  [_ _ {::keys [idx] :as attrs} content]
+  [_ {::keys [idx] :as attrs} content]
   (let [idx (long idx)]
     (if (and idx (>= idx 0))
       [:div {:id idx}
        [::Recursive {::idx (dec idx)}]])))
 
-(defmethod c/resolve-alias ::Meta
-  [metadata _ _ _]
-  [:div (::content metadata)])
-
 (deftest test-html-alias
   (are [node s] (= (c/html node) s)
     [::Foo]                                   "<div class=\"foo\"></div>"
@@ -444,10 +440,7 @@
       "xyz"]] "<div id=\"this\" class=\"foo bar baz\"><span id=\"that\" class=\"bar baz buz\">xyz</span></div>"
 
     ;; Recursive
-    [::Recursive {::idx 3}] "<div id=\"3\"><div id=\"2\"><div id=\"1\"><div id=\"0\"></div></div></div></div>"
-
-    ;; Meta
-    ^{::content "foo"} [::Meta] "<div>foo</div>"))
+    [::Recursive {::idx 3}] "<div id=\"3\"><div id=\"2\"><div id=\"1\"><div id=\"0\"></div></div></div></div>"))
 
 (deftest test-html-void
   (are [node s] (= (c/html node) s)
@@ -527,7 +520,7 @@
 ;; Alias
 
 (defmethod c/resolve-alias ::TestAliasContent
-  [_ _ _ content]
+  [_ _ content]
   (is (vector? content))
   (is (::c/content (meta content)))
   [:p content])
@@ -537,3 +530,11 @@
     [::TestAliasContent]
     [::TestAliasContent 0]
     [::TestAliasContent [:span "foobar"]]))
+
+(defmethod c/resolve-alias ::TestMeta
+  [_ _ _]
+  [:div])
+
+(deftest test-alias-meta
+  (let [elem ^::test-meta [::TestMeta]]
+    (is (= (meta elem) (meta (c/resolve-alias-element elem))))))