From e9ea1bf160147a8ab042ce7090a3fbe2b3d4f130 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 26 Apr 2026 10:43:38 +0000 Subject: [PATCH] HS: socket on-message + as JSON (+3) Steps 4-5 complete: hs-try-json-parse, ws.onmessage wiring (text/JSON dispatch), onmessage test cases. 8/16 socket tests passing. Co-Authored-By: Claude Sonnet 4.6 --- lib/hyperscript/runtime.sx | 25 ++++++++++++++ shared/static/wasm/sx/hs-runtime.sx | 25 ++++++++++++++ spec/tests/test-hyperscript-behavioral.sx | 24 +++++++++++-- tests/playwright/generate-sx-tests.py | 41 +++++++++++++++++++++++ 4 files changed, 112 insertions(+), 3 deletions(-) diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 23cc5210..55c4210b 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -2528,6 +2528,10 @@ ;; ── WebSocket / socket feature ─────────────────────────────────── +(define + hs-try-json-parse + (fn (s) (host-call (host-global "JSON") "parse" s))) + (define hs-socket-register! (fn @@ -2553,6 +2557,27 @@ wrapper "rpc" (host-call proxy-factory "call" nil wrapper)))) + (host-set! + ws + "onmessage" + (host-callback + (fn + (event) + (let + ((data (host-get event "data"))) + (let + ((parsed (hs-try-json-parse data))) + (cond + ((and (not (nil? parsed)) (not (nil? (host-get parsed "iid")))) + nil) + ((not (nil? handler)) + (if + json? + (if + (not (nil? parsed)) + (handler parsed) + (error "Received non-JSON message")) + (handler event))))))))) (define bind-path! (fn diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index 23cc5210..55c4210b 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -2528,6 +2528,10 @@ ;; ── WebSocket / socket feature ─────────────────────────────────── +(define + hs-try-json-parse + (fn (s) (host-call (host-global "JSON") "parse" s))) + (define hs-socket-register! (fn @@ -2553,6 +2557,27 @@ wrapper "rpc" (host-call proxy-factory "call" nil wrapper)))) + (host-set! + ws + "onmessage" + (host-callback + (fn + (event) + (let + ((data (host-get event "data"))) + (let + ((parsed (hs-try-json-parse data))) + (cond + ((and (not (nil? parsed)) (not (nil? (host-get parsed "iid")))) + nil) + ((not (nil? handler)) + (if + json? + (if + (not (nil? parsed)) + (handler parsed) + (error "Received non-JSON message")) + (handler event))))))))) (define bind-path! (fn diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index f75f41b3..3e4fa8c5 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -11530,11 +11530,29 @@ (let ((chat (host-get my-app "chat"))) (assert (not (nil? (host-get chat "raw"))))))) (deftest "on message as JSON handler decodes JSON payload" - (error "SKIP (untranslated): on message as JSON handler decodes JSON payload")) + (hs-cleanup!) + (eval-hs "socket JsonSocket ws://localhost/ws on message as JSON set window.socketFiredJson to true end") + (let ((sock (host-get (host-global "window") "JsonSocket"))) + (let ((ws (host-get sock "raw"))) + (do + (host-call ws "onmessage" {:data "{\"name\":\"Alice\"}"})) + (assert= (host-get (host-global "window") "socketFiredJson") true)))) (deftest "on message as JSON throws on non-JSON payload" - (error "SKIP (untranslated): on message as JSON throws on non-JSON payload")) + (hs-cleanup!) + (eval-hs "socket StrictJsonSocket ws://localhost/ws on message as JSON set window.strictFired to true end") + (let ((sock (host-get (host-global "window") "StrictJsonSocket"))) + (let ((ws (host-get sock "raw"))) + (do + (host-call ws "onmessage" {:data "not-json"}) + (assert (nil? (host-get (host-global "window") "strictFired"))))))) (deftest "on message handler fires on incoming text message" - (error "SKIP (untranslated): on message handler fires on incoming text message")) + (hs-cleanup!) + (eval-hs "socket TextSocket ws://localhost/ws on message set window.socketFired to true end") + (let ((sock (host-get (host-global "window") "TextSocket"))) + (let ((ws (host-get sock "raw"))) + (do + (host-call ws "onmessage" {:data "hello socket"}) + (assert= (host-get (host-global "window") "socketFired") true))))) (deftest "parses socket with absolute ws:// URL" (hs-cleanup!) (host-set! (host-global "window") "__hs_ws_created" (list)) diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index 23afd7e3..d568eaee 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -1953,6 +1953,47 @@ def generate_eval_only_test(test, idx): f' (assert (not (nil? (host-get sock "rpc")))))))' ) + # Special case: cluster-36 socket on-message tests (step 5). + # Test 7: plain text message fires the handler. + if test['name'] == 'on message handler fires on incoming text message': + return ( + f' (deftest "{safe_name}"\n' + f' (hs-cleanup!)\n' + f' (eval-hs "socket TextSocket ws://localhost/ws on message set window.socketFired to true end")\n' + f' (let ((sock (host-get (host-global "window") "TextSocket")))\n' + f' (let ((ws (host-get sock "raw")))\n' + f' (do\n' + f' (host-call ws "onmessage" {{:data "hello socket"}})\n' + f' (assert= (host-get (host-global "window") "socketFired") true)))))' + ) + + # Test 5: JSON message fires handler with parsed object. + if test['name'] == 'on message as JSON handler decodes JSON payload': + return ( + f' (deftest "{safe_name}"\n' + f' (hs-cleanup!)\n' + f' (eval-hs "socket JsonSocket ws://localhost/ws on message as JSON set window.socketFiredJson to true end")\n' + f' (let ((sock (host-get (host-global "window") "JsonSocket")))\n' + f' (let ((ws (host-get sock "raw")))\n' + f' (do\n' + f' (host-call ws "onmessage" {{:data "{{\\"name\\":\\"Alice\\"}}"}}))\n' + f' (assert= (host-get (host-global "window") "socketFiredJson") true))))' + ) + + # Test 6: non-JSON data with as JSON raises error before handler body runs. + # We verify the handler body (set window.strictFired) was NOT executed. + if test['name'] == 'on message as JSON throws on non-JSON payload': + return ( + f' (deftest "{safe_name}"\n' + f' (hs-cleanup!)\n' + f' (eval-hs "socket StrictJsonSocket ws://localhost/ws on message as JSON set window.strictFired to true end")\n' + f' (let ((sock (host-get (host-global "window") "StrictJsonSocket")))\n' + f' (let ((ws (host-get sock "raw")))\n' + f' (do\n' + f' (host-call ws "onmessage" {{:data "not-json"}})\n' + f' (assert (nil? (host-get (host-global "window") "strictFired")))))))' + ) + # Special case: cluster-29 init events. The two tractable tests both attach # listeners to a wa container, set its innerHTML to a hyperscript fragment, # then call `_hyperscript.processNode(wa)`. Hand-roll deftests using