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 <noreply@anthropic.com>
This commit is contained in:
2026-04-26 10:43:38 +00:00
parent ce39a35c6b
commit e9ea1bf160
4 changed files with 112 additions and 3 deletions

View File

@@ -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

View File

@@ -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

View File

@@ -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))

View File

@@ -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