HS: custom conversion API + asExpression tests (+2)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 39s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 39s
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 <noreply@anthropic.com>
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -326,6 +326,27 @@ MANUAL_TEST_BODIES = {
|
||||
' (list (list (quote record) record)))',
|
||||
' "<div age=\\"21\\" style=\\"color:bleaux\\">John Connor</div>"))',
|
||||
],
|
||||
# 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")))',
|
||||
|
||||
Reference in New Issue
Block a user