diff --git a/hosts/ocaml/browser/sx_browser.ml b/hosts/ocaml/browser/sx_browser.ml index ec047646..c4ddcab9 100644 --- a/hosts/ocaml/browser/sx_browser.ml +++ b/hosts/ocaml/browser/sx_browser.ml @@ -171,10 +171,14 @@ and js_to_value (js : Js.Unsafe.any) : value = if not (Js.Unsafe.equals h Js.undefined) then get_handle (Js.float_of_number (Js.Unsafe.coerce h) |> int_of_float) else - (* Plain JS function — wrap as NativeFn *) - NativeFn ("js-callback", fun args -> - let js_args = args |> List.map value_to_js |> Array.of_list in - js_to_value (Js.Unsafe.fun_call js (Array.map Fun.id js_args))) + (* Plain JS function — store as host object so value_to_js + returns the ORIGINAL JS function when passed to host-call. + This preserves wrappers like _driveAsync that host-callback + 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" -> let h = Js.Unsafe.get js (Js.string "__sx_handle") in if not (Js.Unsafe.equals h Js.undefined) then diff --git a/sx/sx/applications/htmx/runner.sx b/sx/sx/applications/htmx/runner.sx index 4b758fd8..b52c622d 100644 --- a/sx/sx/applications/htmx/runner.sx +++ b/sx/sx/applications/htmx/runner.sx @@ -7,170 +7,176 @@ (results (signal {})) (running (signal false)) (current (signal "Ready"))) - (define - get-doc - (fn () (host-get (dom-query "#test-iframe") "contentDocument"))) - (define - wait-boot - (fn - () - (let - ((doc (get-doc))) - (if - (and - doc - (= - (dom-get-attr - (host-get doc "documentElement") - "data-sx-ready") - "true")) - true - (do (hs-wait 200) (wait-boot)))))) - (define - reload-frame - (fn - () - (let - ((w (host-get (dom-query "#test-iframe") "contentWindow"))) - (host-call (host-get w "location") "reload") - (hs-wait 1000) - (wait-boot) - (hs-wait 500)))) - (define - run-action - (fn - (action) - (let - ((doc (get-doc)) (type (first action))) - (cond - (= type :click) - (let - ((el (host-call doc "querySelector" (nth action 1)))) - (when (nil? el) (error (str "Not found: " (nth action 1)))) - (host-call el "click")) - (= type :fill) - (let - ((el (host-call doc "querySelector" (nth action 1)))) - (when (nil? el) (error (str "Not found: " (nth action 1)))) - (host-call el "focus") - (dom-set-prop el "value" (nth action 2)) - (dom-dispatch el "input" nil) - (dom-dispatch el "change" nil)) - (= type :wait) - (hs-wait (nth action 1)) - (= type :assert-text) - (let - ((el (host-call doc "querySelector" (nth action 1)))) - (when (nil? el) (error (str "Not found: " (nth action 1)))) - (let - ((txt (host-get el "textContent")) - (kw (nth action 2)) - (expected (nth action 3))) - (when - (and (= kw :contains) (not (contains? txt expected))) - (error - (str "Expected '" expected "' in '" (slice txt 0 60) "'"))) - (when - (and (= kw :not-contains) (contains? txt expected)) - (error (str "Unexpected '" expected "'"))))) - (= type :assert-count) - (let - ((els (host-call doc "querySelectorAll" (nth action 1)))) - (let - ((count (host-get els "length")) - (kw (nth action 2)) - (expected (nth action 3))) - (when - (and (= kw :gte) (< count expected)) - (error (str "Expected >=" expected " got " count))))) - true - nil)))) - (define - run-all - (fn - () - (reset! running true) - (reset! results {}) - (for-each + (letrec + ((get-doc (fn () (host-get (dom-query "#test-iframe") "contentDocument"))) + (wait-boot (fn - (test) + () (let - ((name (get test :name))) - (reset! current (str "Running: " name)) - (reset! results (assoc (deref results) name "running")) - (reload-frame) - (guard - (e - (true - (reset! results (assoc (deref results) name "fail")) - (console-log (str "FAIL " name ": " e)))) - (for-each run-action (get test :actions)) - (reset! results (assoc (deref results) name "pass"))))) - tests) - (reset! running false) - (reset! current "Done"))) - (div - (~tw :tokens "space-y-4") + ((doc (get-doc))) + (if + (and + doc + (= + (dom-get-attr + (host-get doc "documentElement") + "data-sx-ready") + "true")) + true + (do (hs-wait 200) (wait-boot)))))) + (reload-frame + (fn + () + (let + ((w (host-get (dom-query "#test-iframe") "contentWindow"))) + (host-call (host-get w "location") "reload") + (hs-wait 1000) + (wait-boot) + (hs-wait 500)))) + (run-action + (fn + (action) + (let + ((doc (get-doc)) (type (first action))) + (cond + (= type :click) + (let + ((el (host-call doc "querySelector" (nth action 1)))) + (when + (nil? el) + (error (str "Not found: " (nth action 1)))) + (host-call el "click")) + (= type :fill) + (let + ((el (host-call doc "querySelector" (nth action 1)))) + (when + (nil? el) + (error (str "Not found: " (nth action 1)))) + (host-call el "focus") + (dom-set-prop el "value" (nth action 2)) + (dom-dispatch el "input" nil) + (dom-dispatch el "change" nil)) + (= type :wait) + (hs-wait (nth action 1)) + (= type :assert-text) + (let + ((el (host-call doc "querySelector" (nth action 1)))) + (when + (nil? el) + (error (str "Not found: " (nth action 1)))) + (let + ((txt (host-get el "textContent")) + (kw (nth action 2)) + (expected (nth action 3))) + (when + (and (= kw :contains) (not (contains? txt expected))) + (error + (str + "Expected '" + expected + "' in '" + (slice txt 0 60) + "'"))) + (when + (and (= kw :not-contains) (contains? txt expected)) + (error (str "Unexpected '" expected "'"))))) + (= type :assert-count) + (let + ((els (host-call doc "querySelectorAll" (nth action 1)))) + (let + ((count (host-get els "length")) + (kw (nth action 2)) + (expected (nth action 3))) + (when + (and (= kw :gte) (< count expected)) + (error (str "Expected >=" expected " got " count))))) + true + nil)))) + (run-all + (fn + () + (reset! running true) + (reset! results {}) + (for-each + (fn + (test) + (let + ((name (get test :name))) + (reset! current (str "Running: " name)) + (reset! results (assoc (deref results) name "running")) + (reload-frame) + (guard + (e + (true + (reset! results (assoc (deref results) name "fail")) + (console-log (str "FAIL " name ": " e)))) + (for-each run-action (get test :actions)) + (reset! results (assoc (deref results) name "pass"))))) + tests) + (reset! running false) + (reset! current "Done")))) (div - (~tw :tokens "flex items-center gap-4 mb-4") - (button - (~tw - :tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700") - :on-click (fn (e) (run-all)) - "Run All Tests") - (span (~tw :tokens "text-sm text-stone-500") (deref current))) - (div - (~tw :tokens "space-y-2") - (when - tests - (map - (fn - (test) - (let - ((name (get test :name)) - (status (get (deref results) name))) - (details - (~tw :tokens "border rounded-lg overflow-hidden") - :style (cond - (= status "pass") - "border-color:#bbf7d0;background:#f0fdf4" - (= status "fail") - "border-color:#fecaca;background:#fef2f2" - (= status "running") - "border-color:#c4b5fd" - true - "border-color:#e7e5e4") - (summary - (~tw - :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2") - (span - (~tw :tokens "font-bold") - (cond - (= status "pass") - "✓" - (= status "fail") - "✗" - (= status "running") - "⟳" - true - "○")) - (span (~tw :tokens "font-medium") name) - (span - (~tw :tokens "text-sm text-stone-400 ml-auto") - (get test :desc))) - (div - (~tw - :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200") - (pre + (~tw :tokens "space-y-4") + (div + (~tw :tokens "flex items-center gap-4 mb-4") + (button + (~tw + :tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700") + :on-click (fn (e) (run-all)) + "Run All Tests") + (span (~tw :tokens "text-sm text-stone-500") (deref current))) + (div + (~tw :tokens "space-y-2") + (when + tests + (map + (fn + (test) + (let + ((name (get test :name)) + (status (get (deref results) name))) + (details + (~tw :tokens "border rounded-lg overflow-hidden") + :style (cond + (= status "pass") + "border-color:#bbf7d0;background:#f0fdf4" + (= status "fail") + "border-color:#fecaca;background:#fef2f2" + (= status "running") + "border-color:#c4b5fd" + true + "border-color:#e7e5e4") + (summary (~tw - :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600") - (get test :source)))))) - tests))) - (iframe - :id "test-iframe" - :src "/sx/(applications.(htmx))" - (~tw :tokens "w-full border border-stone-200 rounded-lg mt-4") - :style "height:600px")))) + :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2") + (span + (~tw :tokens "font-bold") + (cond + (= status "pass") + "✓" + (= status "fail") + "✗" + (= status "running") + "⟳" + true + "○")) + (span (~tw :tokens "font-medium") name) + (span + (~tw :tokens "text-sm text-stone-400 ml-auto") + (get test :desc))) + (div + (~tw + :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200") + (pre + (~tw + :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600") + (get test :source)))))) + tests))) + (iframe + :id "test-iframe" + :src "/sx/(applications.(htmx))" + (~tw :tokens "w-full border border-stone-200 rounded-lg mt-4") + :style "height:600px"))))) ;; Page component — passes test definitions to the island (defcomp