From 0753982a0235270abbaa48c79cc0386e1780cb5c Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 5 May 2026 22:35:42 +0000 Subject: [PATCH] HS: custom conversion API + asExpression tests (+2) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add _hs-custom-conversions dict and _hs-dynamic-converters list to runtime.sx. hs-set-conversion!/hs-clear-conversion!/hs-add-dynamic-converter!/ hs-pop-dynamic-converter!/hs-clear-converters! helpers expose the API. hs-coerce fallback now checks static dict then dynamic resolvers before returning value unchanged. Hand-roll MANUAL_TEST_BODIES for "can accept custom conversions" and "can accept custom dynamic conversions" — previously SKIP (untranslated). Co-Authored-By: Claude Sonnet 4.6 --- lib/hyperscript/runtime.sx | 49 ++++++++- shared/static/wasm/sx/hs-runtime.sx | 127 +++++++++++++++++----- spec/tests/test-hyperscript-behavioral.sx | 20 +++- tests/playwright/generate-sx-tests.py | 21 ++++ 4 files changed, 183 insertions(+), 34 deletions(-) diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index cd3edfe9..ed1131cf 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -1156,6 +1156,41 @@ "}"))) (true (hs-json-escape (str v)))))) +(begin + (define _hs-custom-conversions {}) + (define _hs-dynamic-converters (list)) + (define + hs-set-conversion! + (fn (name conv-fn) (dict-set! _hs-custom-conversions name conv-fn))) + (define + hs-clear-conversion! + (fn (name) (dict-set! _hs-custom-conversions name nil))) + (define + hs-add-dynamic-converter! + (fn + (conv-fn) + (set! + _hs-dynamic-converters + (append _hs-dynamic-converters (list conv-fn))))) + (define + hs-pop-dynamic-converter! + (fn + () + (let + ((n (len _hs-dynamic-converters))) + (when + (> n 0) + (set! + _hs-dynamic-converters + (slice _hs-dynamic-converters 0 (- n 1))))))) + (define + hs-clear-converters! + (fn + () + (do + (set! _hs-custom-conversions {}) + (set! _hs-dynamic-converters (list)))))) + (define hs-coerce (fn @@ -1280,7 +1315,15 @@ (filter (fn (k) (not (= k "_order"))) (keys value)))) m))) ((= type-name "Date") (host-new "Date" value)) - (true value)))) + (true + (let + ((static-fn (get _hs-custom-conversions type-name))) + (if + (not (nil? static-fn)) + (static-fn value) + (let + ((dynamic-result (reduce (fn (acc resolver) (if (not (nil? acc)) acc (resolver type-name value))) nil _hs-dynamic-converters))) + (if (not (nil? dynamic-result)) dynamic-result value)))))))) (define hs-gather-form-nodes @@ -2722,6 +2765,8 @@ ((store (host-get el "__hs_vars"))) (if (nil? store) nil (host-get store name))))) +;; ── SourceInfo API ──────────────────────────────────────────────── + (define hs-dom-set-var-raw! (fn @@ -2735,8 +2780,6 @@ (host-set! (host-get el "__hs_vars") name val) (when changed (hs-dom-fire-watchers! el name val)))))) -;; ── SourceInfo API ──────────────────────────────────────────────── - (define hs-dom-resolve-start (fn diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index dcfed022..ed1131cf 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -411,7 +411,7 @@ (do (dom-set-inner-html target value) (hs-boot-subtree! target))))) - ((= pos "beforebegin") + ((or (= pos "beforebegin") (= pos "before")) (if (hs-element? value) (let @@ -422,7 +422,7 @@ (do (dom-insert-adjacent-html target "beforebegin" value) (when parent (hs-boot-subtree! parent)))))) - ((= pos "afterend") + ((or (= pos "afterend") (= pos "after")) (if (hs-element? value) (let @@ -439,7 +439,7 @@ (do (dom-insert-adjacent-html target "afterend" value) (when parent (hs-boot-subtree! parent)))))) - ((= pos "afterbegin") + ((or (= pos "afterbegin") (= pos "start")) (cond ((list? value) (append! target value 0)) ((hs-element? value) (dom-prepend target value)) @@ -447,7 +447,7 @@ (do (dom-insert-adjacent-html target "afterbegin" value) (hs-boot-subtree! target))))) - ((= pos "beforeend") + ((or (= pos "beforeend") (= pos "end")) (cond ((list? value) (append! target value)) ((hs-element? value) (dom-append target value)) @@ -470,6 +470,7 @@ (some (fn (x) (= x value)) target) target (append target (list value)))) + ((hs-is-set? target) (do (host-call target "add" value) target)) (true (do (host-call target "push" value) target))))) ;; ── Object creation ───────────────────────────────────────────── @@ -480,10 +481,10 @@ hs-remove-from! (fn (value target) - (if - (list? target) - (filter (fn (x) (not (= x value))) target) - (host-call target "splice" (host-call target "indexOf" value) 1)))) + (cond + ((list? target) (filter (fn (x) (not (= x value))) target)) + ((hs-is-set? target) (do (host-call target "delete" value) target)) + (true (host-call target "splice" (host-call target "indexOf" value) 1))))) ;; ── Behavior installation ─────────────────────────────────────── @@ -965,6 +966,7 @@ (some (fn (x) (= x value)) target) target (append target (list value)))) + ((hs-is-set? target) (do (host-call target "add" value) target)) ((hs-element? target) (do (dom-insert-adjacent-html @@ -998,7 +1000,7 @@ (event) (let ((detail (host-get event "detail"))) - (if detail (host-get detail "sender") nil)))) + (if detail (get detail "sender") nil)))) (define hs-host-to-sx @@ -1154,6 +1156,41 @@ "}"))) (true (hs-json-escape (str v)))))) +(begin + (define _hs-custom-conversions {}) + (define _hs-dynamic-converters (list)) + (define + hs-set-conversion! + (fn (name conv-fn) (dict-set! _hs-custom-conversions name conv-fn))) + (define + hs-clear-conversion! + (fn (name) (dict-set! _hs-custom-conversions name nil))) + (define + hs-add-dynamic-converter! + (fn + (conv-fn) + (set! + _hs-dynamic-converters + (append _hs-dynamic-converters (list conv-fn))))) + (define + hs-pop-dynamic-converter! + (fn + () + (let + ((n (len _hs-dynamic-converters))) + (when + (> n 0) + (set! + _hs-dynamic-converters + (slice _hs-dynamic-converters 0 (- n 1))))))) + (define + hs-clear-converters! + (fn + () + (do + (set! _hs-custom-conversions {}) + (set! _hs-dynamic-converters (list)))))) + (define hs-coerce (fn @@ -1260,23 +1297,33 @@ value) value)) ((= type-name "Set") - (if - (list? value) - (reduce - (fn - (acc x) - (if (some (fn (a) (= a x)) acc) acc (append acc (list x)))) - (list) - value) - value)) + (let + ((s (host-new "Set"))) + (do + (when + (list? value) + (for-each (fn (x) (host-call s "add" x)) value)) + s))) ((= type-name "Map") - (if - (dict? value) - (let - ((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value))))) - (map (fn (k) (list k (get value k))) ks)) - value)) - (true value)))) + (let + ((m (host-new "Map"))) + (do + (when + (dict? value) + (for-each + (fn (k) (host-call m "set" k (get value k))) + (filter (fn (k) (not (= k "_order"))) (keys value)))) + m))) + ((= type-name "Date") (host-new "Date" value)) + (true + (let + ((static-fn (get _hs-custom-conversions type-name))) + (if + (not (nil? static-fn)) + (static-fn value) + (let + ((dynamic-result (reduce (fn (acc resolver) (if (not (nil? acc)) acc (resolver type-name value))) nil _hs-dynamic-converters))) + (if (not (nil? dynamic-result)) dynamic-result value)))))))) (define hs-gather-form-nodes @@ -1471,8 +1518,8 @@ (cond ((= type-name "Object") (dict)) ((= type-name "Array") (list)) - ((= type-name "Set") (list)) - ((= type-name "Map") (dict)) + ((= type-name "Set") (host-new "Set")) + ((= type-name "Map") (host-new "Map")) (true (dict))) (apply host-new (cons type-name args))))))) (define @@ -1871,6 +1918,8 @@ (cond ((list? v) (list)) ((dict? v) (dict)) + ((hs-is-set? v) (host-new "Set")) + ((hs-is-map? v) (host-new "Map")) ((string? v) "") ((nil? v) nil) (true v)))) @@ -2386,6 +2435,26 @@ pairs) d)))) +(define + hs-strip-order-deep + (fn + (val) + (cond + ((dict? val) + (let + ((d (dict))) + (do + (for-each + (fn + (k) + (when + (not (= k "_order")) + (dict-set! d k (hs-strip-order-deep (get val k))))) + (filter (fn (k) (not (= k "_order"))) (keys val))) + d))) + ((list? val) (map hs-strip-order-deep val)) + (true val)))) + (define hs-method-call (fn @@ -2696,6 +2765,8 @@ ((store (host-get el "__hs_vars"))) (if (nil? store) nil (host-get store name))))) +;; ── SourceInfo API ──────────────────────────────────────────────── + (define hs-dom-set-var-raw! (fn @@ -2728,8 +2799,6 @@ (if match (dom-parent match) nil))) (true el)))))) -;; ── SourceInfo API ──────────────────────────────────────────────── - (define hs-dom-walk (fn diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index d4342d60..655d464e 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -3724,9 +3724,25 @@ ;; ── expressions/asExpression (42 tests) ── (defsuite "hs-upstream-expressions/asExpression" (deftest "can accept custom conversions" - (error "SKIP (untranslated): can accept custom conversions")) + (do + (hs-set-conversion! "Foo" (fn (val) (str "foo" (str val)))) + (let ((result (hs-coerce 1 "Foo"))) + (do + (hs-clear-conversion! "Foo") + (assert= result "foo1")))) + ) (deftest "can accept custom dynamic conversions" - (error "SKIP (untranslated): can accept custom dynamic conversions")) + (do + (hs-add-dynamic-converter! + (fn (conversion val) + (if (= (host-call conversion "indexOf" "Foo:") 0) + (str (host-call conversion "slice" 4) (str val)) + nil))) + (let ((result (hs-coerce 1 "Foo:Bar"))) + (do + (hs-pop-dynamic-converter!) + (assert= result "Bar1")))) + ) (deftest "can use the a modifier if you like" (let ((_result (eval-hs "1 as a Date"))) (assert= (host-call _result "getTime") 1)) diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index f0a8de2a..e0a2684b 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -326,6 +326,27 @@ MANUAL_TEST_BODIES = { ' (list (list (quote record) record)))', ' "
John Connor
"))', ], + # asExpression: custom conversions — set/clear via hs-set-conversion! + hs-add-dynamic-converter! + "can accept custom conversions": [ + ' (do', + ' (hs-set-conversion! "Foo" (fn (val) (str "foo" (str val))))', + ' (let ((result (hs-coerce 1 "Foo")))', + ' (do', + ' (hs-clear-conversion! "Foo")', + ' (assert= result "foo1"))))', + ], + "can accept custom dynamic conversions": [ + ' (do', + ' (hs-add-dynamic-converter!', + ' (fn (conversion val)', + ' (if (= (host-call conversion "indexOf" "Foo:") 0)', + ' (str (host-call conversion "slice" 4) (str val))', + ' nil)))', + ' (let ((result (hs-coerce 1 "Foo:Bar")))', + ' (do', + ' (hs-pop-dynamic-converter!)', + ' (assert= result "Bar1"))))', + ], # asExpression: Date/Set/Map need real JS host objects "converts value as Date": [ ' (let ((_result (eval-hs "1 as Date")))',