Island body: letrec instead of define (fixes render-to-dom), host-object JS fns
runner.sx: Converted define forms inside island body to letrec. Multiple define forms in a let body cause render-to-dom to fall back to eval-expr for the whole body, which evaluates (div ...) as a list instead of rendering it to DOM. letrec keeps the last body expression (div) as the render target. sx_browser.ml: js_to_value now stores plain JS functions as host objects (Dict with __host_handle) instead of wrapping as NativeFn. This preserves the original JS function identity through the SX→JS round-trip, keeping _driveAsync wrappers from host-callback intact when passed to addEventListener via host-call. Remaining: IO suspension in click handler is caught as "IO suspension in non-IO context" instead of being driven by _driveAsync. The host-callback wrapper creates the right JS function, but the event dispatch path doesn't go through K.callFn. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -171,10 +171,14 @@ and js_to_value (js : Js.Unsafe.any) : value =
|
|||||||
if not (Js.Unsafe.equals h Js.undefined) then
|
if not (Js.Unsafe.equals h Js.undefined) then
|
||||||
get_handle (Js.float_of_number (Js.Unsafe.coerce h) |> int_of_float)
|
get_handle (Js.float_of_number (Js.Unsafe.coerce h) |> int_of_float)
|
||||||
else
|
else
|
||||||
(* Plain JS function — wrap as NativeFn *)
|
(* Plain JS function — store as host object so value_to_js
|
||||||
NativeFn ("js-callback", fun args ->
|
returns the ORIGINAL JS function when passed to host-call.
|
||||||
let js_args = args |> List.map value_to_js |> Array.of_list in
|
This preserves wrappers like _driveAsync that host-callback
|
||||||
js_to_value (Js.Unsafe.fun_call js (Array.map Fun.id js_args)))
|
attaches for IO suspension handling. *)
|
||||||
|
let id = host_put js in
|
||||||
|
let d = Hashtbl.create 2 in
|
||||||
|
Hashtbl.replace d "__host_handle" (Number (float_of_int id));
|
||||||
|
Dict d
|
||||||
| "object" ->
|
| "object" ->
|
||||||
let h = Js.Unsafe.get js (Js.string "__sx_handle") in
|
let h = Js.Unsafe.get js (Js.string "__sx_handle") in
|
||||||
if not (Js.Unsafe.equals h Js.undefined) then
|
if not (Js.Unsafe.equals h Js.undefined) then
|
||||||
|
|||||||
@@ -7,11 +7,9 @@
|
|||||||
(results (signal {}))
|
(results (signal {}))
|
||||||
(running (signal false))
|
(running (signal false))
|
||||||
(current (signal "Ready")))
|
(current (signal "Ready")))
|
||||||
(define
|
(letrec
|
||||||
get-doc
|
((get-doc (fn () (host-get (dom-query "#test-iframe") "contentDocument")))
|
||||||
(fn () (host-get (dom-query "#test-iframe") "contentDocument")))
|
(wait-boot
|
||||||
(define
|
|
||||||
wait-boot
|
|
||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(let
|
(let
|
||||||
@@ -26,8 +24,7 @@
|
|||||||
"true"))
|
"true"))
|
||||||
true
|
true
|
||||||
(do (hs-wait 200) (wait-boot))))))
|
(do (hs-wait 200) (wait-boot))))))
|
||||||
(define
|
(reload-frame
|
||||||
reload-frame
|
|
||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(let
|
(let
|
||||||
@@ -36,8 +33,7 @@
|
|||||||
(hs-wait 1000)
|
(hs-wait 1000)
|
||||||
(wait-boot)
|
(wait-boot)
|
||||||
(hs-wait 500))))
|
(hs-wait 500))))
|
||||||
(define
|
(run-action
|
||||||
run-action
|
|
||||||
(fn
|
(fn
|
||||||
(action)
|
(action)
|
||||||
(let
|
(let
|
||||||
@@ -46,12 +42,16 @@
|
|||||||
(= type :click)
|
(= type :click)
|
||||||
(let
|
(let
|
||||||
((el (host-call doc "querySelector" (nth action 1))))
|
((el (host-call doc "querySelector" (nth action 1))))
|
||||||
(when (nil? el) (error (str "Not found: " (nth action 1))))
|
(when
|
||||||
|
(nil? el)
|
||||||
|
(error (str "Not found: " (nth action 1))))
|
||||||
(host-call el "click"))
|
(host-call el "click"))
|
||||||
(= type :fill)
|
(= type :fill)
|
||||||
(let
|
(let
|
||||||
((el (host-call doc "querySelector" (nth action 1))))
|
((el (host-call doc "querySelector" (nth action 1))))
|
||||||
(when (nil? el) (error (str "Not found: " (nth action 1))))
|
(when
|
||||||
|
(nil? el)
|
||||||
|
(error (str "Not found: " (nth action 1))))
|
||||||
(host-call el "focus")
|
(host-call el "focus")
|
||||||
(dom-set-prop el "value" (nth action 2))
|
(dom-set-prop el "value" (nth action 2))
|
||||||
(dom-dispatch el "input" nil)
|
(dom-dispatch el "input" nil)
|
||||||
@@ -61,7 +61,9 @@
|
|||||||
(= type :assert-text)
|
(= type :assert-text)
|
||||||
(let
|
(let
|
||||||
((el (host-call doc "querySelector" (nth action 1))))
|
((el (host-call doc "querySelector" (nth action 1))))
|
||||||
(when (nil? el) (error (str "Not found: " (nth action 1))))
|
(when
|
||||||
|
(nil? el)
|
||||||
|
(error (str "Not found: " (nth action 1))))
|
||||||
(let
|
(let
|
||||||
((txt (host-get el "textContent"))
|
((txt (host-get el "textContent"))
|
||||||
(kw (nth action 2))
|
(kw (nth action 2))
|
||||||
@@ -69,7 +71,12 @@
|
|||||||
(when
|
(when
|
||||||
(and (= kw :contains) (not (contains? txt expected)))
|
(and (= kw :contains) (not (contains? txt expected)))
|
||||||
(error
|
(error
|
||||||
(str "Expected '" expected "' in '" (slice txt 0 60) "'")))
|
(str
|
||||||
|
"Expected '"
|
||||||
|
expected
|
||||||
|
"' in '"
|
||||||
|
(slice txt 0 60)
|
||||||
|
"'")))
|
||||||
(when
|
(when
|
||||||
(and (= kw :not-contains) (contains? txt expected))
|
(and (= kw :not-contains) (contains? txt expected))
|
||||||
(error (str "Unexpected '" expected "'")))))
|
(error (str "Unexpected '" expected "'")))))
|
||||||
@@ -85,8 +92,7 @@
|
|||||||
(error (str "Expected >=" expected " got " count)))))
|
(error (str "Expected >=" expected " got " count)))))
|
||||||
true
|
true
|
||||||
nil))))
|
nil))))
|
||||||
(define
|
(run-all
|
||||||
run-all
|
|
||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(reset! running true)
|
(reset! running true)
|
||||||
@@ -108,7 +114,7 @@
|
|||||||
(reset! results (assoc (deref results) name "pass")))))
|
(reset! results (assoc (deref results) name "pass")))))
|
||||||
tests)
|
tests)
|
||||||
(reset! running false)
|
(reset! running false)
|
||||||
(reset! current "Done")))
|
(reset! current "Done"))))
|
||||||
(div
|
(div
|
||||||
(~tw :tokens "space-y-4")
|
(~tw :tokens "space-y-4")
|
||||||
(div
|
(div
|
||||||
@@ -170,7 +176,7 @@
|
|||||||
:id "test-iframe"
|
:id "test-iframe"
|
||||||
:src "/sx/(applications.(htmx))"
|
:src "/sx/(applications.(htmx))"
|
||||||
(~tw :tokens "w-full border border-stone-200 rounded-lg mt-4")
|
(~tw :tokens "w-full border border-stone-200 rounded-lg mt-4")
|
||||||
:style "height:600px"))))
|
:style "height:600px")))))
|
||||||
|
|
||||||
;; Page component — passes test definitions to the island
|
;; Page component — passes test definitions to the island
|
||||||
(defcomp
|
(defcomp
|
||||||
|
|||||||
Reference in New Issue
Block a user