From 2dadb6a521d04ccaea5a463e370c70ae717cfbe2 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 26 Apr 2026 22:04:28 +0000 Subject: [PATCH] HS: fetch response unwrap + do-not-throw + dot-prop + JSON coerce (+19 tests) --- lib/hyperscript/compiler.sx | 7 +++-- lib/hyperscript/parser.sx | 8 ++++++ lib/hyperscript/runtime.sx | 41 +++++++++++++++++++++++----- shared/static/wasm/sx/hs-compiler.sx | 7 +++-- shared/static/wasm/sx/hs-parser.sx | 8 ++++++ shared/static/wasm/sx/hs-runtime.sx | 41 +++++++++++++++++++++++----- tests/hs-run-filtered.js | 2 ++ 7 files changed, 96 insertions(+), 18 deletions(-) diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index cac9a430..f11c2678 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -1746,6 +1746,7 @@ (list? c) (or (= (first c) (quote hs-fetch)) + (= (first c) (quote hs-fetch-no-throw)) (= (first c) (quote hs-wait)) (= (first c) (quote hs-wait-for)) (= (first c) (quote hs-wait-for-or)) @@ -1759,7 +1760,9 @@ (if (and (list? cmd) - (= (first cmd) (quote hs-fetch))) + (or + (= (first cmd) (quote hs-fetch)) + (= (first cmd) (quote hs-fetch-no-throw)))) (list (quote let) (list (list (quote it) cmd)) @@ -1882,7 +1885,7 @@ (list (quote fn) (list) (hs-to-sx (nth ast 2))))) ((= head (quote fetch)) (list - (quote hs-fetch) + (if (nth ast 3) (quote hs-fetch-no-throw) (quote hs-fetch)) (hs-to-sx (nth ast 1)) (nth ast 2))) ((= head (quote fetch-gql)) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 52fc9dde..f721aa6e 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -438,6 +438,14 @@ ((and (= (tp-type) "op") (= (tp-val) "'s")) (do (adv!) (parse-poss-tail obj))) ((= (tp-type) "class") (parse-prop-chain obj)) + ((= (tp-type) "dot") + (do + (adv!) + (let ((typ2 (tp-type)) (val2 (tp-val))) + (if + (or (= typ2 "ident") (= typ2 "keyword")) + (do (adv!) (parse-poss (list (make-symbol ".") obj val2))) + obj)))) ((= (tp-type) "paren-open") (let ((args (parse-call-args))) diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 474fdc92..4826b92b 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -888,14 +888,40 @@ out))))))))))) (define - hs-fetch + hs-fetch-impl (fn - (url format) + (url format no-throw) (let - ((fmt (cond ((nil? format) "text") ((or (= format "json") (= format "JSON") (= format "Object")) "json") ((or (= format "html") (= format "HTML")) "html") ((or (= format "response") (= format "Response")) "response") ((or (= format "text") (= format "Text")) "text") (true format)))) + ((fmt (cond + ((nil? format) "text") + ((or (= format "json") (= format "JSON") (= format "Object")) "json") + ((or (= format "html") (= format "HTML")) "html") + ((or (= format "response") (= format "Response")) "response") + ((or (= format "text") (= format "Text")) "text") + ((or (= format "number") (= format "Number")) "number") + (true "text")))) (let ((raw (perform (list "io-fetch" url fmt)))) - (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw)))))) + (begin + (when (= (host-get raw "_network-error") true) + (raise (or (host-get raw "message") "Network error"))) + (when (and (not no-throw) (not (= fmt "response")) (= (host-get raw "ok") false)) + (raise (str "HTTP Error: " (host-get raw "status")))) + (cond + ((= fmt "response") raw) + ((= fmt "json") + (hs-host-to-sx (perform (list "io-parse-json" raw)))) + ((= fmt "number") + (hs-to-number (perform (list "io-parse-text" raw)))) + (true (perform (list "io-parse-text" raw))))))))) + +(define + hs-fetch + (fn (url format) (hs-fetch-impl url format false))) + +(define + hs-fetch-no-throw + (fn (url format) (hs-fetch-impl url format true))) (define hs-json-escape @@ -986,9 +1012,10 @@ (true (str value)))) ((= type-name "JSON") (cond - ((string? value) (guard (_e (true value)) (json-parse value))) - ((dict? value) (hs-json-stringify value)) - ((list? value) (hs-json-stringify value)) + ((string? value) (guard (_e (true value)) (hs-host-to-sx (json-parse value)))) + ((not (nil? (host-get value "_json"))) + (hs-host-to-sx (perform (list "io-parse-json" value)))) + ((dict? value) value) (true value))) ((= type-name "Object") (if diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index cac9a430..f11c2678 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -1746,6 +1746,7 @@ (list? c) (or (= (first c) (quote hs-fetch)) + (= (first c) (quote hs-fetch-no-throw)) (= (first c) (quote hs-wait)) (= (first c) (quote hs-wait-for)) (= (first c) (quote hs-wait-for-or)) @@ -1759,7 +1760,9 @@ (if (and (list? cmd) - (= (first cmd) (quote hs-fetch))) + (or + (= (first cmd) (quote hs-fetch)) + (= (first cmd) (quote hs-fetch-no-throw)))) (list (quote let) (list (list (quote it) cmd)) @@ -1882,7 +1885,7 @@ (list (quote fn) (list) (hs-to-sx (nth ast 2))))) ((= head (quote fetch)) (list - (quote hs-fetch) + (if (nth ast 3) (quote hs-fetch-no-throw) (quote hs-fetch)) (hs-to-sx (nth ast 1)) (nth ast 2))) ((= head (quote fetch-gql)) diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index 52fc9dde..f721aa6e 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -438,6 +438,14 @@ ((and (= (tp-type) "op") (= (tp-val) "'s")) (do (adv!) (parse-poss-tail obj))) ((= (tp-type) "class") (parse-prop-chain obj)) + ((= (tp-type) "dot") + (do + (adv!) + (let ((typ2 (tp-type)) (val2 (tp-val))) + (if + (or (= typ2 "ident") (= typ2 "keyword")) + (do (adv!) (parse-poss (list (make-symbol ".") obj val2))) + obj)))) ((= (tp-type) "paren-open") (let ((args (parse-call-args))) diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index 474fdc92..4826b92b 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -888,14 +888,40 @@ out))))))))))) (define - hs-fetch + hs-fetch-impl (fn - (url format) + (url format no-throw) (let - ((fmt (cond ((nil? format) "text") ((or (= format "json") (= format "JSON") (= format "Object")) "json") ((or (= format "html") (= format "HTML")) "html") ((or (= format "response") (= format "Response")) "response") ((or (= format "text") (= format "Text")) "text") (true format)))) + ((fmt (cond + ((nil? format) "text") + ((or (= format "json") (= format "JSON") (= format "Object")) "json") + ((or (= format "html") (= format "HTML")) "html") + ((or (= format "response") (= format "Response")) "response") + ((or (= format "text") (= format "Text")) "text") + ((or (= format "number") (= format "Number")) "number") + (true "text")))) (let ((raw (perform (list "io-fetch" url fmt)))) - (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw)))))) + (begin + (when (= (host-get raw "_network-error") true) + (raise (or (host-get raw "message") "Network error"))) + (when (and (not no-throw) (not (= fmt "response")) (= (host-get raw "ok") false)) + (raise (str "HTTP Error: " (host-get raw "status")))) + (cond + ((= fmt "response") raw) + ((= fmt "json") + (hs-host-to-sx (perform (list "io-parse-json" raw)))) + ((= fmt "number") + (hs-to-number (perform (list "io-parse-text" raw)))) + (true (perform (list "io-parse-text" raw))))))))) + +(define + hs-fetch + (fn (url format) (hs-fetch-impl url format false))) + +(define + hs-fetch-no-throw + (fn (url format) (hs-fetch-impl url format true))) (define hs-json-escape @@ -986,9 +1012,10 @@ (true (str value)))) ((= type-name "JSON") (cond - ((string? value) (guard (_e (true value)) (json-parse value))) - ((dict? value) (hs-json-stringify value)) - ((list? value) (hs-json-stringify value)) + ((string? value) (guard (_e (true value)) (hs-host-to-sx (json-parse value)))) + ((not (nil? (host-get value "_json"))) + (hs-host-to-sx (perform (list "io-parse-json" value)))) + ((dict? value) value) (true value))) ((= type-name "Object") (if diff --git a/tests/hs-run-filtered.js b/tests/hs-run-filtered.js index d00f7e39..d2bac0e7 100755 --- a/tests/hs-run-filtered.js +++ b/tests/hs-run-filtered.js @@ -652,6 +652,8 @@ const _fetchScripts = { { "/test": { networkError: true } }, "triggers an event just before fetching": { "/test": { status: 200, body: "yay", contentType: "text/html" } }, + "can do a simple fetch w/ a custom conversion": + { "/test": { status: 200, body: "1.2" } }, }; function _mockFetch(url) { const scriptRoutes = _fetchScripts[globalThis.__currentHsTestName];