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

Merge branch 'hs-e40-fetch' into loops/hs
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 16s
Details

Browse Source
This commit is contained in:
giles
2026-04-26 17:54:34 +00:00
parent 4c48a8dd57 4c43918a99
commit 41fac7ac29
13 changed files with 256 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
shared/static/wasm/sx/hs-compiler.sx
View File

@@ -1838,7 +1838,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) (quote me)))
((= head (quote fetch-gql))
(list
(quote hs-fetch-gql)

24
shared/static/wasm/sx/hs-parser.sx
View File

@@ -1772,7 +1772,7 @@
((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil)))
(list (quote fetch-gql) gql-source url))))
(let
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (= (tp-type) "ident") (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom))))
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (and (= (tp-type) "ident") (not (string-contains? (tp-val) "'"))) (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom))))
(let
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
(let
@@ -1788,7 +1788,27 @@
((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
(cond
((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)))
((and (= (tp-type) "ident") (= (tp-val) "don't"))
(do
(adv!)
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw"))
(do (adv!) true)
false)))
(true false))))
(list (quote fetch) url fmt do-not-throw))))))))))
(define
parse-call-args
(fn

33
shared/static/wasm/sx/hs-runtime.sx
View File

@@ -869,12 +869,33 @@
(define
hs-fetch
(fn
(url format)
(url format do-not-throw target)
(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))))
(let
((raw (perform (list "io-fetch" url fmt))))
(cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
((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))))
(do
(when (not (nil? target))
(dom-dispatch target "hyperscript:beforeFetch" nil))
(let
((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
@@ -965,6 +986,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))

24
shared/static/wasm/sx/hs-tokenizer.sx
View File

@@ -568,10 +568,26 @@
(do
(let
((word (read-ident start)))
(hs-emit!
(if (hs-keyword? word) "keyword" "ident")
word
start))
(let
((full-word
(if
(and
(< pos src-len)
(= (hs-cur) "'")
(< (+ pos 1) src-len)
(hs-letter? (hs-peek 1))
(not
(and
(= (hs-peek 1) "s")
(or
(>= (+ pos 2) src-len)
(not (hs-ident-char? (hs-peek 2)))))))
(do (hs-advance! 1) (str word "'" (read-ident pos)))
word)))
(hs-emit!
(if (hs-keyword? full-word) "keyword" "ident")
full-word
start)))
(scan!))
(and
(or (= ch "=") (= ch "!") (= ch "<") (= ch ">"))