coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

HS E36: socket URL parsing + hs-socket-register! runtime (+3 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 15s
Details

Browse Source 
- parser.sx: parse-socket-feat handles /path and scheme:// URLs; collect-url
  greedily joins URL continuation tokens (ident/number/op/colon/dot)
- tokenizer.sx: fix :// not treated as line comment (lookback check)
- compiler.sx: emit-socket compiles socket AST to hs-socket-register! call
- runtime.sx: hs-socket-register! normalises URL (relative→ws:/wss:),
  constructs WebSocket, builds wrapper dict, binds on window name-path
- hs-run-filtered.js: WebSocket mock uses plain object (not JS array) so
  host-global returns a foreign value rather than SX list; host-get idx works

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-26 09:55:48 +00:00
parent c2dcc94ce2
commit a20c9c4625
15 changed files with 291 additions and 65 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
lib/hyperscript/compiler.sx
View File

@@ -787,6 +787,31 @@
(quote fn)
(cons (quote me) (map make-symbol params))
(cons (quote do) (map hs-to-sx body)))))))
(define
emit-socket
(fn
(ast)
(let
((name-path (nth ast 1))
(url (nth ast 2))
(timeout-ms (nth ast 3))
(on-msg (nth ast 4)))
(let
((handler
(if
(nil? on-msg)
nil
(let
((body (hs-to-sx (nth on-msg 2))))
(list (quote fn) (list (quote event)) body))))
(json?-val (if (nil? on-msg) false (nth on-msg 1))))
(list
(quote hs-socket-register!)
(cons (quote list) name-path)
url
(if (nil? timeout-ms) nil (hs-to-sx timeout-ms))
handler
json?-val)))))
(fn
(ast)
(cond
@@ -2075,6 +2100,7 @@
(quote _hs-def-val))
(quote _hs-def-val))))))
((= head (quote behavior)) (emit-behavior ast))
((= head (quote socket)) (emit-socket ast))
((= head (quote sx-eval))
(let
((src (nth ast 1)))

48
lib/hyperscript/parser.sx
View File

@@ -2733,7 +2733,6 @@
parse-socket-feat
(fn
()
;; Collect name-path: ident (class)* → e.g. ["Foo"] or ["MyApp" "chat"]
(let
((seg0 (tp-val)))
(adv!)
@@ -2750,7 +2749,6 @@
acc)))
(let
((name-path (collect-segs (list seg0))))
;; url-cont?: token types that can appear inside a URL
(define
url-cont?
(fn
@@ -2769,7 +2767,6 @@
(= (tp-val) "with")
(= (tp-val) "on")
(= (tp-val) "as")))))))
;; collect-url: accumulate URL tokens into a joined string
(define
collect-url
(fn
@@ -2781,51 +2778,12 @@
(adv!)
(collect-url (append parts (list v))))
(join "" parts))))
;; Parse URL: /path, scheme://..., string literal, or expression
(let
((url
(cond
;; Relative path starting with /
((and (= (tp-type) "op") (= (tp-val) "/"))
(adv!)
(collect-url (list "/")))
;; Absolute URL: ident + colon → collect as scheme:rest
((= (tp-type) "ident")
(let
((scheme (tp-val)))
(adv!)
(if
(= (tp-type) "colon")
(collect-url (list scheme))
(parse-arith (parse-poss (list (quote ref) scheme))))))
;; String literal or other expression
(true (parse-atom)))))
;; Optional: with timeout <expr>
((url (cond ((and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (collect-url (list "/")))) ((= (tp-type) "ident") (let ((scheme (tp-val))) (adv!) (if (= (tp-type) "colon") (collect-url (list scheme)) (parse-arith (parse-poss (list (quote ref) scheme)))))) (true (parse-atom)))))
(let
((timeout-ms
(if
(match-kw "with")
(do
(adv!)
(parse-expr))
nil)))
;; Optional: on message [as JSON] <cmd-list>
((timeout-ms (if (match-kw "with") (do (adv!) (parse-expr)) nil)))
(let
((on-msg
(if
(match-kw "on")
(do
(adv!)
(let
((json?
(if
(match-kw "as")
(do (adv!) true)
false)))
(let
((body (parse-cmd-list)))
(list (quote on-message) json? body))))
nil)))
((on-msg (if (match-kw "on") (do (adv!) (let ((json? (if (match-kw "as") (do (adv!) true) false))) (let ((body (parse-cmd-list))) (list (quote on-message) json? body)))) nil)))
(match-kw "end")
(list (quote socket) name-path url timeout-ms on-msg))))))))
(define

53
lib/hyperscript/runtime.sx
View File

@@ -2525,3 +2525,56 @@
(fn
(fn-name args)
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
;; ── WebSocket / socket feature ───────────────────────────────────
(define
hs-socket-register!
(fn
(name-path url timeout-ms handler json?)
;; 1. Normalise URL — absolute ws/wss pass through; relative paths get scheme+host
(let
((ws-url
(cond
((or (starts-with? url "ws://") (starts-with? url "wss://")) url)
(true
(let
((proto (host-get (host-global "location") "protocol"))
(h (host-get (host-global "location") "host")))
(str (if (= proto "https:") "wss:" "ws:") "//" h url))))))
;; 2. Construct WebSocket
(let
((ws (host-new "WebSocket" ws-url)))
;; 3. Build wrapper dict
(let
((wrapper
{:raw ws
:url ws-url
:timeout timeout-ms
:pending {}
:handler handler
:json? json?
:closed? false}))
;; 4. Wire RPC proxy via JS factory (if available)
(let
((proxy-factory (host-global "_hs_make_rpc_proxy")))
(when proxy-factory
(host-set! wrapper "rpc"
(host-call proxy-factory "call" nil wrapper))))
;; 5. Bind wrapper on window, walking name-path
(define
bind-path!
(fn
(obj path)
(if
(= (len path) 1)
(host-set! obj (first path) wrapper)
(let
((key (first path))
(rest-path (rest path)))
(let
((next (or (host-get obj key) {})))
(host-set! obj key next)
(bind-path! next rest-path))))))
(bind-path! (host-global "window") name-path)
wrapper)))))

6
lib/hyperscript/tokenizer.sx
View File

@@ -441,7 +441,11 @@
(cond
(and (= ch "-") (< (+ pos 1) src-len) (= (hs-peek 1) "-"))
(do (hs-advance! 2) (skip-comment!) (scan!))
(and (= ch "/") (< (+ pos 1) src-len) (= (hs-peek 1) "/"))
(and
(= ch "/")
(< (+ pos 1) src-len)
(= (hs-peek 1) "/")
(not (and (> pos 0) (= (hs-peek -1) ":"))))
(do (hs-advance! 2) (skip-comment!) (scan!))
(and
(= ch "<")