From 3a755947ef58167bdd9ff7d47ce258554f865129 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 26 Apr 2026 10:03:06 +0000 Subject: [PATCH] HS: fetch do-not-throw modifier (+1 test) --- lib/hyperscript/compiler.sx | 2 +- lib/hyperscript/parser.sx | 15 ++++++++++++++- lib/hyperscript/runtime.sx | 28 ++++++++++++++++++++++++---- shared/static/wasm/sx/hs-compiler.sx | 2 +- shared/static/wasm/sx/hs-parser.sx | 15 ++++++++++++++- shared/static/wasm/sx/hs-runtime.sx | 28 ++++++++++++++++++++++++---- 6 files changed, 78 insertions(+), 12 deletions(-) diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index c7549d51..7d296f3e 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -1832,7 +1832,7 @@ (list (quote fn) (list) (hs-to-sx (nth ast 1))) (list (quote fn) (list) (hs-to-sx (nth ast 2))))) ((= head (quote fetch)) - (list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2))) + (list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2) (nth ast 3))) ((= head (quote fetch-gql)) (list (quote hs-fetch-gql) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 0c337953..ce28b3f4 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -1700,7 +1700,20 @@ ((fmt-after (if (and (not fmt-before) (match-kw "as")) (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil))) (let ((fmt (or fmt-before fmt-after "text"))) - (list (quote fetch) url fmt))))))))) + (let + ((do-not-throw + (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) + (do + (adv!) + (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) + (do + (adv!) + (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) + (do (adv!) true) + false)) + false)) + false))) + (list (quote fetch) url fmt do-not-throw)))))))))) (define parse-call-args (fn diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 4daa71d9..7a749487 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -874,12 +874,30 @@ (define hs-fetch (fn - (url format) + (url format do-not-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 format)))) (let - ((raw (perform (list "io-fetch" url fmt)))) - (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw)))))) + ((raw (perform (list "io-fetch" url "response" (dict))))) + (do + (when (get raw :_network-error) (raise {:response raw :message "Network error" :_hs-error "FetchError"})) + (when + (and (not (get raw :ok)) (not (= fmt "response")) (not do-not-throw)) + (raise {:response raw :status (get raw :status) :message "Fetch error" :_hs-error "FetchError"})) + (cond + ((= fmt "response") raw) + ((= fmt "json") + (let + ((parsed (perform (list "io-parse-json" (get raw :_json))))) + (hs-host-to-sx parsed))) + ((= fmt "html") + (perform (list "io-parse-html" (get raw :_html)))) + ((= fmt "number") + (or + (parse-number (get raw :_number)) + (parse-number (get raw :_body)) + 0)) + (true (get raw :_body)))))))) (define hs-json-escape @@ -970,6 +988,8 @@ (true (str value)))) ((= type-name "JSON") (cond + ((and (dict? value) (dict-has? value :_json)) + (guard (_e (true value)) (json-parse (get value :_json)))) ((string? value) (guard (_e (true value)) (json-parse value))) ((dict? value) (hs-json-stringify value)) ((list? value) (hs-json-stringify value)) diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index c7549d51..7d296f3e 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -1832,7 +1832,7 @@ (list (quote fn) (list) (hs-to-sx (nth ast 1))) (list (quote fn) (list) (hs-to-sx (nth ast 2))))) ((= head (quote fetch)) - (list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2))) + (list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2) (nth ast 3))) ((= head (quote fetch-gql)) (list (quote hs-fetch-gql) diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index 0c337953..ce28b3f4 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -1700,7 +1700,20 @@ ((fmt-after (if (and (not fmt-before) (match-kw "as")) (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil))) (let ((fmt (or fmt-before fmt-after "text"))) - (list (quote fetch) url fmt))))))))) + (let + ((do-not-throw + (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) + (do + (adv!) + (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) + (do + (adv!) + (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) + (do (adv!) true) + false)) + false)) + false))) + (list (quote fetch) url fmt do-not-throw)))))))))) (define parse-call-args (fn diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index 4daa71d9..7a749487 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -874,12 +874,30 @@ (define hs-fetch (fn - (url format) + (url format do-not-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 format)))) (let - ((raw (perform (list "io-fetch" url fmt)))) - (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw)))))) + ((raw (perform (list "io-fetch" url "response" (dict))))) + (do + (when (get raw :_network-error) (raise {:response raw :message "Network error" :_hs-error "FetchError"})) + (when + (and (not (get raw :ok)) (not (= fmt "response")) (not do-not-throw)) + (raise {:response raw :status (get raw :status) :message "Fetch error" :_hs-error "FetchError"})) + (cond + ((= fmt "response") raw) + ((= fmt "json") + (let + ((parsed (perform (list "io-parse-json" (get raw :_json))))) + (hs-host-to-sx parsed))) + ((= fmt "html") + (perform (list "io-parse-html" (get raw :_html)))) + ((= fmt "number") + (or + (parse-number (get raw :_number)) + (parse-number (get raw :_body)) + 0)) + (true (get raw :_body)))))))) (define hs-json-escape @@ -970,6 +988,8 @@ (true (str value)))) ((= type-name "JSON") (cond + ((and (dict? value) (dict-has? value :_json)) + (guard (_e (true value)) (json-parse (get value :_json)))) ((string? value) (guard (_e (true value)) (json-parse value))) ((dict? value) (hs-json-stringify value)) ((list? value) (hs-json-stringify value))