HS: fetch do-not-throw modifier (+1 test)

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)

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

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))))
+        ((raw (perform (list "io-fetch" url "response" (dict)))))
-        (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
+        (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))

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)

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

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))))
+        ((raw (perform (list "io-fetch" url "response" (dict)))))
-        (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
+        (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))