diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index ec706aa3..cbf79a60 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -368,6 +368,9 @@ let cek_run_with_io state = loop () (** IO-aware eval_expr — like eval_expr but handles IO suspension. *) +(* IO-aware eval — used by site_mode. The regular file loading path + uses Sx_ref.eval_expr which delegates IO suspension to the + _cek_io_suspend_hook → _vm_suspension_to_dict chain. *) let _eval_expr_io expr env = let state = Sx_ref.make_cek_state expr env (List []) in cek_run_with_io state diff --git a/shared/static/wasm/sx/boot-helpers.sx b/shared/static/wasm/sx/boot-helpers.sx index 220976a9..b843d88b 100644 --- a/shared/static/wasm/sx/boot-helpers.sx +++ b/shared/static/wasm/sx/boot-helpers.sx @@ -2,779 +2,815 @@ (import (sx browser)) (import (web adapter-dom)) -(define-library (web boot-helpers) - (export _sx-bound-prefix mark-processed! is-processed? clear-processed! callable? to-kebab sx-load-components call-expr base-env get-render-env merge-envs sx-render-with-env parse-env-attr store-env-attr resolve-mount-target remove-head-element set-sx-comp-cookie clear-sx-comp-cookie log-parse-error loaded-component-names csrf-token validate-for-request build-request-body abort-previous-target abort-previous track-controller track-controller-target new-abort-controller abort-signal apply-optimistic revert-optimistic dom-has-attr? show-indicator disable-elements clear-loading-state abort-error? promise-catch fetch-request fetch-location fetch-and-restore fetch-preload fetch-streaming dom-parse-html-document dom-body-inner-html create-script-clone cross-origin? browser-scroll-to with-transition event-source-connect event-source-listen bind-boost-link bind-boost-form bind-client-route-click sw-post-message try-parse-json strip-component-scripts extract-response-css sx-render sx-hydrate sx-process-scripts select-from-container children-to-fragment select-html-from-doc register-io-deps resolve-page-data parse-sx-data try-eval-content try-async-eval-content try-rerender-page execute-action bind-preload persist-offline-data retrieve-offline-data) +(define-library + (web boot-helpers) + (export + _sx-bound-prefix + mark-processed! + is-processed? + clear-processed! + callable? + to-kebab + sx-load-components + call-expr + base-env + get-render-env + merge-envs + sx-render-with-env + parse-env-attr + store-env-attr + resolve-mount-target + remove-head-element + set-sx-comp-cookie + clear-sx-comp-cookie + log-parse-error + loaded-component-names + csrf-token + validate-for-request + build-request-body + abort-previous-target + abort-previous + track-controller + track-controller-target + new-abort-controller + abort-signal + apply-optimistic + revert-optimistic + dom-has-attr? + show-indicator + disable-elements + clear-loading-state + abort-error? + promise-catch + fetch-request + fetch-location + fetch-and-restore + fetch-preload + fetch-streaming + dom-parse-html-document + dom-body-inner-html + create-script-clone + cross-origin? + browser-scroll-to + with-transition + event-source-connect + event-source-listen + bind-boost-link + bind-boost-form + bind-client-route-click + sw-post-message + try-parse-json + strip-component-scripts + extract-response-css + sx-render + sx-hydrate + sx-process-scripts + select-from-container + children-to-fragment + select-html-from-doc + register-io-deps + resolve-page-data + parse-sx-data + try-eval-content + try-async-eval-content + try-rerender-page + execute-action + bind-preload + persist-offline-data + retrieve-offline-data) (begin - -(define _sx-bound-prefix "_sxBound") - -(define - mark-processed! - (fn (el key) (host-set! el (str _sx-bound-prefix key) true))) - -(define - is-processed? - (fn - (el key) - (let ((v (host-get el (str _sx-bound-prefix key)))) (if v true false)))) - -(define - clear-processed! - (fn (el key) (host-set! el (str _sx-bound-prefix key) nil))) - -(define - callable? - (fn - (v) - (let - ((t (type-of v))) - (or (= t "lambda") (= t "native-fn") (= t "continuation"))))) - -(define - to-kebab - (fn - (s) - "Convert camelCase to kebab-case." - (let - ((result (list)) (i 0)) - (let - loop - ((i 0)) - (when - (< i (len s)) + (define _sx-bound-prefix "_sxBound") + (define + mark-processed! + (fn (el key) (host-set! el (str _sx-bound-prefix key) true))) + (define + is-processed? + (fn + (el key) + (let + ((v (host-get el (str _sx-bound-prefix key)))) + (if v true false)))) + (define + clear-processed! + (fn (el key) (host-set! el (str _sx-bound-prefix key) nil))) + (define + callable? + (fn + (v) + (let + ((t (type-of v))) + (or (= t "lambda") (= t "function") (= t "continuation"))))) + (define + to-kebab + (fn + (s) + "Convert camelCase to kebab-case." + (let + ((result (list)) (i 0)) (let - ((ch (nth s i))) - (if - (and (>= ch "A") (<= ch "Z")) - (do - (when (> i 0) (append! result "-")) - (append! result (lower ch))) - (append! result ch)) - (loop (+ i 1))))) - (join "" result)))) - -(define - sx-load-components - (fn - (text) - "Parse and evaluate component definitions from text." - (when - (and text (> (len text) 0)) - (let - ((exprs (sx-parse text))) - (for-each (fn (expr) (cek-eval expr)) exprs))))) - -(define - call-expr - (fn - (expr-text env-bindings) - "Parse and evaluate an SX expression string." - (let - ((exprs (sx-parse expr-text))) - (when (not (empty? exprs)) (cek-eval (first exprs)))))) - -(define - base-env - (fn () "Return the current global environment." (global-env))) - -(define - get-render-env - (fn - (extra) - "Get the rendering environment (global env, optionally merged with extra)." - (let - ((env (base-env))) - (if (and extra (not (nil? extra))) (env-merge env extra) env)))) - -(define - merge-envs - (fn - (a b) - "Merge two environments." - (if (and a b) (env-merge a b) (or a b (global-env))))) - -(define - sx-render-with-env - (fn - (source extra-env) - "Parse SX source and render to DOM fragment." - (let - ((doc (host-global "document")) - (frag (host-call doc "createDocumentFragment")) - (exprs (sx-parse source))) - (for-each - (fn - (expr) - (let - ((html (render-to-html expr))) + loop + ((i 0)) (when - (and html (> (len html) 0)) + (< i (len s)) (let - ((temp (host-call doc "createElement" "template"))) - (host-set! temp "innerHTML" html) - (host-call frag "appendChild" (host-get temp "content")))))) - exprs) - frag))) - -(define - parse-env-attr - (fn (el) "Parse data-sx-env attribute (JSON key-value pairs)." nil)) - -(define store-env-attr (fn (el base new-env) nil)) - -(define - resolve-mount-target - (fn - (target) - "Resolve a CSS selector string to a DOM element." - (if (string? target) (dom-query target) target))) - -(define - remove-head-element - (fn - (sel) - "Remove a element matching selector." - (let ((el (dom-query sel))) (when el (dom-remove el))))) - -(define set-sx-comp-cookie (fn (hash) (set-cookie "sx-components" hash))) - -(define clear-sx-comp-cookie (fn () (set-cookie "sx-components" ""))) - -(define - log-parse-error - (fn (label text err) (log-error (str "Parse error in " label ": " err)))) - -(define - loaded-component-names - (fn - () - (let - ((scripts (dom-query-all (dom-body) "script[data-components]")) - (names (list))) - (for-each - (fn - (script) - (let - ((text (or (dom-get-attr script "data-components") ""))) - (when - (> (len text) 0) - (for-each - (fn - (name) - (when - (> (len (trim name)) 0) - (append! names (trim name)))) - (split text ","))))) - scripts) - names))) - -(define - csrf-token - (fn - () - (let - ((meta (dom-query "meta[name=\"csrf-token\"]"))) - (if meta (dom-get-attr meta "content") nil)))) - -(define validate-for-request (fn (el) true)) - -(define - build-request-body - (fn - (el method url) - (let - ((m (upper method))) - (if - (or (= m "GET") (= m "HEAD")) - (if - (and el (= (upper (or (dom-tag-name el) "")) "FORM")) - (let - ((fd (host-new "FormData" el)) - (params (host-new "URLSearchParams" fd)) - (qs (host-call params "toString"))) - (dict - "url" - (if - (and qs (> (len qs) 0)) - (str url (if (contains? url "?") "&" "?") qs) - url) - "body" - nil - "content-type" - nil)) - (dict "url" url "body" nil "content-type" nil)) - (if - (and el (= (upper (or (dom-tag-name el) "")) "FORM")) - (let - ((enctype (or (dom-get-attr el "enctype") "application/x-www-form-urlencoded"))) - (if - (= enctype "multipart/form-data") - (let - ((fd (host-new "FormData" el))) - (dict "url" url "body" fd "content-type" nil)) - (let - ((fd (host-new "FormData" el)) - (params (host-new "URLSearchParams" fd))) - (dict - "url" - url - "body" - (host-call params "toString") - "content-type" - "application/x-www-form-urlencoded")))) - (dict "url" url "body" nil "content-type" nil)))))) - -(define abort-previous-target (fn (el) nil)) - -(define abort-previous (fn (el) nil)) - -(define track-controller (fn (el ctrl) nil)) - -(define track-controller-target (fn (el ctrl) nil)) - -(define new-abort-controller (fn () (host-new "AbortController"))) - -(define abort-signal (fn (ctrl) (host-get ctrl "signal"))) - -(define apply-optimistic (fn (el) nil)) - -(define revert-optimistic (fn (el) nil)) - -(define dom-has-attr? (fn (el name) (host-call el "hasAttribute" name))) - -(define - show-indicator - (fn - (el) - (let - ((indicator-sel (dom-get-attr el "sx-indicator"))) - (when - indicator-sel - (let - ((indicator (dom-query indicator-sel))) - (when - indicator - (dom-remove-class indicator "hidden") - (dom-add-class indicator "sx-indicator-visible")))) - indicator-sel))) - -(define - disable-elements - (fn - (el) - (let - ((disable-sel (dom-get-attr el "sx-disabled-elt"))) - (if - disable-sel - (let - ((elts (dom-query-all (dom-body) disable-sel))) - (for-each (fn (e) (dom-set-attr e "disabled" "")) elts) - elts) - (list))))) - -(define - clear-loading-state - (fn - (el indicator disabled-elts) - (dom-remove-class el "sx-request") - (dom-remove-attr el "aria-busy") - (when - indicator - (let - ((ind (dom-query indicator))) - (when - ind - (dom-add-class ind "hidden") - (dom-remove-class ind "sx-indicator-visible")))) - (when - disabled-elts - (for-each (fn (e) (dom-remove-attr e "disabled")) disabled-elts)))) - -(define abort-error? (fn (err) (= (host-get err "name") "AbortError"))) - -(define - promise-catch - (fn (p f) (let ((cb (host-callback f))) (host-call p "catch" cb)))) - -(define - fetch-request - (fn - (config success-fn error-fn) - (let - ((url (get config "url")) - (method (or (get config "method") "GET")) - (headers (or (get config "headers") (dict))) - (body (get config "body")) - (signal (get config "signal")) - (preloaded (get config "preloaded"))) - (if - preloaded - (success-fn true 200 (fn (name) nil) preloaded) - (let - ((h (host-new "Headers")) (js-opts (host-new "Object"))) - (for-each - (fn (k) (host-call h "set" k (get headers k))) - (keys headers)) - (host-set! js-opts "method" method) - (host-set! js-opts "headers" h) - (when body (host-set! js-opts "body" body)) - (when signal (host-set! js-opts "signal" signal)) - (promise-then - (host-call (dom-window) "fetch" url js-opts) - (fn - (response) - (let - ((ok (host-get response "ok")) - (status (host-get response "status")) - (get-header - (fn - (name) - (host-call (host-get response "headers") "get" name)))) - (promise-then - (host-call response "text") - (fn (text) (success-fn ok status get-header text)) - error-fn))) - error-fn)))))) - -(define - fetch-location - (fn - (url) - (let - ((target (or (dom-query "[sx-boost]") (dom-query "#main-panel")))) - (when target (browser-navigate url))))) - -(define - fetch-and-restore - (fn - (main url headers scroll-y) - (fetch-request - (dict "url" url "method" "GET" "headers" headers "body" nil "signal" nil) - (fn - (resp-ok status get-header text) - (when - resp-ok - (let - ((ct (or (get-header "content-type") ""))) - (if - (contains? ct "text/html") - (let - ((parser (host-new "DOMParser")) - (doc (host-call parser "parseFromString" text "text/html")) - (content (host-call doc "querySelector" "#sx-content"))) + ((ch (nth s i))) (if - content - (dom-set-inner-html main (host-get content "innerHTML")) - (dom-set-inner-html main text))) - (let - ((container (dom-create-element "div"))) - (let - ((rendered (sx-render text))) - (when - rendered - (dom-append container rendered) - (process-oob-swaps - container - (fn - (t oob (s :as string)) - (dispose-islands-in t) - (swap-dom-nodes - t - (if - (= s "innerHTML") - (children-to-fragment oob) - oob) - s) - (post-swap t))) - (let - ((content (select-from-container container "#sx-content"))) - (if - content - (do - (dispose-islands-in main) - (dom-set-inner-html main "") - (dom-append main content)) - (do - (dispose-islands-in main) - (dom-set-inner-html - main - (dom-get-inner-html container)))))))))) - (post-swap main) - (host-call (dom-window) "scrollTo" 0 scroll-y))) - (fn (err) (log-warn (str "fetch-and-restore error: " err)))))) - -(define - fetch-preload - (fn - (url headers cache) - (fetch-request - (dict "url" url "method" "GET" "headers" headers "body" nil "signal" nil) + (and (>= ch "A") (<= ch "Z")) + (do + (when (> i 0) (append! result "-")) + (append! result (lower ch))) + (append! result ch)) + (loop (+ i 1))))) + (join "" result)))) + (define + sx-load-components (fn - (resp-ok status get-header text) - (when resp-ok (preload-cache-set cache url text))) - (fn (err) nil)))) - -(define - fetch-streaming - (fn - (target pathname headers swap-fn) - (fetch-and-restore target pathname headers 0))) - -(define - dom-parse-html-document - (fn - (text) - (let - ((parser (host-new "DOMParser"))) - (host-call parser "parseFromString" text "text/html")))) - -(define - dom-body-inner-html - (fn (doc) (host-get (host-get doc "body") "innerHTML"))) - -(define - create-script-clone - (fn - (dead) - (let - ((doc (host-global "document")) - (live (host-call doc "createElement" "script"))) - (let - ((attrs (host-get dead "attributes"))) - (let - loop - ((i 0)) - (when - (< i (host-get attrs "length")) - (let - ((attr (host-call attrs "item" i))) - (host-call - live - "setAttribute" - (host-get attr "name") - (host-get attr "value")) - (loop (+ i 1)))))) - (host-set! live "textContent" (host-get dead "textContent")) - live))) - -(define - cross-origin? - (fn - (url) - (if - (or (starts-with? url "http://") (starts-with? url "https://")) - (not (starts-with? url (browser-location-origin))) - false))) - -(define - browser-scroll-to - (fn (x y) (host-call (dom-window) "scrollTo" x y))) - -(define - with-transition - (fn - (enabled thunk) - (if - (and enabled (host-get (host-global "document") "startViewTransition")) - (host-call - (host-global "document") - "startViewTransition" - (host-callback thunk)) - (thunk)))) - -(define - event-source-connect - (fn - (url el) - (let - ((source (host-new "EventSource" url))) - (host-set! source "_sxElement" el) - source))) - -(define - event-source-listen - (fn - (source event-name handler) - (host-call - source - "addEventListener" - event-name - (host-callback (fn (e) (handler e)))))) - -(define - bind-boost-link - (fn - (el href) - (dom-listen - el - "click" - (fn - (e) + (text) + "Parse and evaluate component definitions from text." (when - (not (event-modifier-key? e)) - (prevent-default e) - (when - (not (dom-has-attr? el "sx-get")) - (dom-set-attr el "sx-get" href)) - (when - (not (dom-has-attr? el "sx-push-url")) - (dom-set-attr el "sx-push-url" "true")) - (execute-request el nil nil)))))) - -(define - bind-boost-form - (fn - (form method action) - (dom-listen - form - "submit" - (fn (e) (prevent-default e) (execute-request form nil nil))))) - -(define - bind-client-route-click - (fn - (link href fallback-fn) - (dom-listen - link - "click" + (and text (> (len text) 0)) + (let + ((exprs (sx-parse text))) + (for-each (fn (expr) (cek-eval expr)) exprs))))) + (define + call-expr (fn - (e) - (when - (not (event-modifier-key? e)) - (prevent-default e) - (let - ((boost-el (dom-query "[sx-boost]")) - (target-sel - (if - boost-el - (let - ((attr (dom-get-attr boost-el "sx-boost"))) - (if (and attr (not (= attr "true"))) attr "#sx-content")) - "#sx-content"))) - (if - (try-client-route (url-pathname href) target-sel) - (do - (save-scroll-position) - (browser-push-state nil "" href) - (browser-scroll-to 0 0)) - (do - (log-info (str "sx:route server fetch " href)) - (dom-set-attr link "sx-get" href) - (dom-set-attr link "sx-target" target-sel) - (dom-set-attr link "sx-select" target-sel) - (dom-set-attr link "sx-push-url" "true") - (execute-request link nil nil))))))))) - -(define sw-post-message (fn (msg) nil)) - -(define try-parse-json (fn (text) (json-parse text))) - -(define - strip-component-scripts - (fn - (text) - (let - ((result text) - (start-tag "")) - (let - loop - ((s result)) + (expr-text env-bindings) + "Parse and evaluate an SX expression string." (let - ((start-idx (index-of s start-tag))) - (if - (= start-idx -1) - (set! result s) - (let - ((after-start (+ start-idx (len start-tag))) - (rest-str (slice s (+ start-idx (len start-tag))))) - (let - ((end-offset (index-of rest-str end-tag))) - (if - (= end-offset -1) - (set! result s) - (let - ((comp-text (slice rest-str 0 end-offset)) - (before (slice s 0 start-idx)) - (after (slice rest-str (+ end-offset (len end-tag))))) - (sx-load-components comp-text) - (loop (str before after))))))))) - result))) - -(define - extract-response-css - (fn - (text) - (let - ((result text) (start-tag "")) - (let - loop - ((s result)) + ((exprs (sx-parse expr-text))) + (when (not (empty? exprs)) (cek-eval (first exprs)))))) + (define + base-env + (fn () "Return the current global environment." (global-env))) + (define + get-render-env + (fn + (extra) + "Get the rendering environment (global env, optionally merged with extra)." (let - ((start-idx (index-of s start-tag))) - (if - (= start-idx -1) - (set! result s) - (let - ((rest-str (slice s (+ start-idx (len start-tag))))) - (let - ((end-offset (index-of rest-str end-tag))) - (if - (= end-offset -1) - (set! result s) - (let - ((css-text (slice rest-str 0 end-offset)) - (before (slice s 0 start-idx)) - (after (slice rest-str (+ end-offset (len end-tag))))) - (let - ((doc (host-global "document")) - (style-el (host-call doc "createElement" "style"))) - (host-set! style-el "textContent" css-text) - (dom-append-to-head style-el)) - (loop (str before after))))))))) - result))) - -(define - sx-render - (fn - (text) - (let - ((doc (host-global "document")) - (frag (host-call doc "createDocumentFragment")) - (exprs (sx-parse text))) - (scope-push! "sx-render-markers" true) - (for-each - (fn - (expr) - (let - ((result (try-catch (fn () (render-to-dom expr (get-render-env nil) nil)) (fn (err) (log-error (str "sx-render: " err)) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:4px;margin:0.25rem 0;") (dom-set-text-content el (str "Render error: " err)) el))))) - (when result (dom-append frag result)))) - exprs) - (scope-pop! "sx-render-markers") - frag))) - -(define sx-hydrate (fn (root) (sx-hydrate-elements (or root (dom-body))))) - -(define - sx-process-scripts - (fn - (root) - (let - ((scripts (dom-query-all (or root (dom-body)) "script[type=\"text/sx\"]"))) - (for-each - (fn - (s) - (when - (not (is-processed? s "sx-script")) - (mark-processed! s "sx-script") - (let - ((text (host-get s "textContent"))) - (when - (and text (> (len text) 0)) - (let - ((exprs (sx-parse text))) - (for-each - (fn - (expr) - (try-catch - (fn () (cek-eval expr)) - (fn - (err) - (log-error (str "sx-process-scripts: " err))))) - exprs)))))) - scripts)))) - -(define - select-from-container - (fn - (container selector) - (if - selector - (let - ((selected (dom-query container selector))) - (if - selected - (children-to-fragment selected) - (children-to-fragment container))) - (children-to-fragment container)))) - -(define - children-to-fragment - (fn - (el) - (let - ((doc (host-global "document")) - (frag (host-call doc "createDocumentFragment"))) - (let - loop - () + ((env (base-env))) + (if (and extra (not (nil? extra))) (env-merge env extra) env)))) + (define + merge-envs + (fn + (a b) + "Merge two environments." + (if (and a b) (env-merge a b) (or a b (global-env))))) + (define + sx-render-with-env + (fn + (source extra-env) + "Parse SX source and render to DOM fragment." (let - ((child (dom-first-child el))) - (when child (dom-append frag child) (loop)))) - frag))) - -(define - select-html-from-doc - (fn - (doc selector) - (if - selector - (let - ((el (dom-query doc selector))) - (if el (dom-inner-html el) (dom-body-inner-html doc))) - (dom-body-inner-html doc)))) - -(define register-io-deps (fn (deps) nil)) - -(define resolve-page-data (fn (page-name params callback) nil)) - -(define - parse-sx-data - (fn - (text) - (if - (and text (> (len text) 0)) - (let - ((exprs (sx-parse text))) - (if (not (empty? exprs)) (first exprs) nil)) - nil))) - -(define - try-eval-content - (fn - (content-src env) - (let - ((exprs (sx-parse content-src))) - (if - (empty? exprs) - nil - (let - ((frag (create-fragment))) + ((doc (host-global "document")) + (frag (host-call doc "createDocumentFragment")) + (exprs (sx-parse source))) (for-each (fn (expr) (let - ((result (render-to-dom expr env nil))) + ((html (render-to-html expr))) + (when + (and html (> (len html) 0)) + (let + ((temp (host-call doc "createElement" "template"))) + (host-set! temp "innerHTML" html) + (host-call frag "appendChild" (host-get temp "content")))))) + exprs) + frag))) + (define + parse-env-attr + (fn (el) "Parse data-sx-env attribute (JSON key-value pairs)." nil)) + (define store-env-attr (fn (el base new-env) nil)) + (define + resolve-mount-target + (fn + (target) + "Resolve a CSS selector string to a DOM element." + (if (string? target) (dom-query target) target))) + (define + remove-head-element + (fn + (sel) + "Remove a element matching selector." + (let ((el (dom-query sel))) (when el (dom-remove el))))) + (define + set-sx-comp-cookie + (fn (hash) (set-cookie "sx-components" hash))) + (define clear-sx-comp-cookie (fn () (set-cookie "sx-components" ""))) + (define + log-parse-error + (fn + (label text err) + (log-error (str "Parse error in " label ": " err)))) + (define + loaded-component-names + (fn + () + (let + ((scripts (dom-query-all (dom-body) "script[data-components]")) + (names (list))) + (for-each + (fn + (script) + (let + ((text (or (dom-get-attr script "data-components") ""))) + (when + (> (len text) 0) + (for-each + (fn + (name) + (when + (> (len (trim name)) 0) + (append! names (trim name)))) + (split text ","))))) + scripts) + names))) + (define + csrf-token + (fn + () + (let + ((meta (dom-query "meta[name=\"csrf-token\"]"))) + (if meta (dom-get-attr meta "content") nil)))) + (define validate-for-request (fn (el) true)) + (define + build-request-body + (fn + (el method url) + (let + ((m (upper method))) + (if + (or (= m "GET") (= m "HEAD")) + (if + (and el (= (upper (or (dom-tag-name el) "")) "FORM")) + (let + ((fd (host-new "FormData" el)) + (params (host-new "URLSearchParams" fd)) + (qs (host-call params "toString"))) + (dict + "url" + (if + (and qs (> (len qs) 0)) + (str url (if (contains? url "?") "&" "?") qs) + url) + "body" + nil + "content-type" + nil)) + (dict "url" url "body" nil "content-type" nil)) + (if + (and el (= (upper (or (dom-tag-name el) "")) "FORM")) + (let + ((enctype (or (dom-get-attr el "enctype") "application/x-www-form-urlencoded"))) + (if + (= enctype "multipart/form-data") + (let + ((fd (host-new "FormData" el))) + (dict "url" url "body" fd "content-type" nil)) + (let + ((fd (host-new "FormData" el)) + (params (host-new "URLSearchParams" fd))) + (dict + "url" + url + "body" + (host-call params "toString") + "content-type" + "application/x-www-form-urlencoded")))) + (dict "url" url "body" nil "content-type" nil)))))) + (define abort-previous-target (fn (el) nil)) + (define abort-previous (fn (el) nil)) + (define track-controller (fn (el ctrl) nil)) + (define track-controller-target (fn (el ctrl) nil)) + (define new-abort-controller (fn () (host-new "AbortController"))) + (define abort-signal (fn (ctrl) (host-get ctrl "signal"))) + (define apply-optimistic (fn (el) nil)) + (define revert-optimistic (fn (el) nil)) + (define dom-has-attr? (fn (el name) (host-call el "hasAttribute" name))) + (define + show-indicator + (fn + (el) + (let + ((indicator-sel (dom-get-attr el "sx-indicator"))) + (when + indicator-sel + (let + ((indicator (dom-query indicator-sel))) + (when + indicator + (dom-remove-class indicator "hidden") + (dom-add-class indicator "sx-indicator-visible")))) + indicator-sel))) + (define + disable-elements + (fn + (el) + (let + ((disable-sel (dom-get-attr el "sx-disabled-elt"))) + (if + disable-sel + (let + ((elts (dom-query-all (dom-body) disable-sel))) + (for-each (fn (e) (dom-set-attr e "disabled" "")) elts) + elts) + (list))))) + (define + clear-loading-state + (fn + (el indicator disabled-elts) + (dom-remove-class el "sx-request") + (dom-remove-attr el "aria-busy") + (when + indicator + (let + ((ind (dom-query indicator))) + (when + ind + (dom-add-class ind "hidden") + (dom-remove-class ind "sx-indicator-visible")))) + (when + disabled-elts + (for-each (fn (e) (dom-remove-attr e "disabled")) disabled-elts)))) + (define abort-error? (fn (err) (= (host-get err "name") "AbortError"))) + (define + promise-catch + (fn (p f) (let ((cb (host-callback f))) (host-call p "catch" cb)))) + (define + fetch-request + (fn + (config success-fn error-fn) + (let + ((url (get config "url")) + (method (or (get config "method") "GET")) + (headers (or (get config "headers") (dict))) + (body (get config "body")) + (signal (get config "signal")) + (preloaded (get config "preloaded"))) + (if + preloaded + (success-fn true 200 (fn (name) nil) preloaded) + (let + ((h (host-new "Headers")) (js-opts (host-new "Object"))) + (for-each + (fn (k) (host-call h "set" k (get headers k))) + (keys headers)) + (host-set! js-opts "method" method) + (host-set! js-opts "headers" h) + (when body (host-set! js-opts "body" body)) + (when signal (host-set! js-opts "signal" signal)) + (promise-then + (host-call (dom-window) "fetch" url js-opts) + (fn + (response) + (let + ((ok (host-get response "ok")) + (status (host-get response "status")) + (get-header + (fn + (name) + (host-call (host-get response "headers") "get" name)))) + (promise-then + (host-call response "text") + (fn (text) (success-fn ok status get-header text)) + error-fn))) + error-fn)))))) + (define + fetch-location + (fn + (url) + (let + ((target (or (dom-query "[sx-boost]") (dom-query "#main-panel")))) + (when target (browser-navigate url))))) + (define + fetch-and-restore + (fn + (main url headers scroll-y) + (fetch-request + (dict + "url" + url + "method" + "GET" + "headers" + headers + "body" + nil + "signal" + nil) + (fn + (resp-ok status get-header text) + (when + resp-ok + (let + ((ct (or (get-header "content-type") ""))) + (if + (contains? ct "text/html") + (let + ((parser (host-new "DOMParser")) + (doc + (host-call parser "parseFromString" text "text/html")) + (content (host-call doc "querySelector" "#sx-content"))) + (if + content + (dom-set-inner-html main (host-get content "innerHTML")) + (dom-set-inner-html main text))) + (let + ((container (dom-create-element "div"))) + (let + ((rendered (sx-render text))) + (when + rendered + (dom-append container rendered) + (process-oob-swaps + container + (fn + (t oob (s :as string)) + (dispose-islands-in t) + (swap-dom-nodes + t + (if + (= s "innerHTML") + (children-to-fragment oob) + oob) + s) + (post-swap t))) + (let + ((content (select-from-container container "#sx-content"))) + (if + content + (do + (dispose-islands-in main) + (dom-set-inner-html main "") + (dom-append main content)) + (do + (dispose-islands-in main) + (dom-set-inner-html + main + (dom-get-inner-html container)))))))))) + (post-swap main) + (host-call (dom-window) "scrollTo" 0 scroll-y))) + (fn (err) (log-warn (str "fetch-and-restore error: " err)))))) + (define + fetch-preload + (fn + (url headers cache) + (fetch-request + (dict + "url" + url + "method" + "GET" + "headers" + headers + "body" + nil + "signal" + nil) + (fn + (resp-ok status get-header text) + (when resp-ok (preload-cache-set cache url text))) + (fn (err) nil)))) + (define + fetch-streaming + (fn + (target pathname headers swap-fn) + (fetch-and-restore target pathname headers 0))) + (define + dom-parse-html-document + (fn + (text) + (let + ((parser (host-new "DOMParser"))) + (host-call parser "parseFromString" text "text/html")))) + (define + dom-body-inner-html + (fn (doc) (host-get (host-get doc "body") "innerHTML"))) + (define + create-script-clone + (fn + (dead) + (let + ((doc (host-global "document")) + (live (host-call doc "createElement" "script"))) + (let + ((attrs (host-get dead "attributes"))) + (let + loop + ((i 0)) + (when + (< i (host-get attrs "length")) + (let + ((attr (host-call attrs "item" i))) + (host-call + live + "setAttribute" + (host-get attr "name") + (host-get attr "value")) + (loop (+ i 1)))))) + (host-set! live "textContent" (host-get dead "textContent")) + live))) + (define + cross-origin? + (fn + (url) + (if + (or (starts-with? url "http://") (starts-with? url "https://")) + (not (starts-with? url (browser-location-origin))) + false))) + (define + browser-scroll-to + (fn (x y) (host-call (dom-window) "scrollTo" x y))) + (define + with-transition + (fn + (enabled thunk) + (if + (and + enabled + (host-get (host-global "document") "startViewTransition")) + (host-call + (host-global "document") + "startViewTransition" + (host-callback thunk)) + (thunk)))) + (define + event-source-connect + (fn + (url el) + (let + ((source (host-new "EventSource" url))) + (host-set! source "_sxElement" el) + source))) + (define + event-source-listen + (fn + (source event-name handler) + (host-call + source + "addEventListener" + event-name + (host-callback (fn (e) (handler e)))))) + (define + bind-boost-link + (fn + (el href) + (dom-listen + el + "click" + (fn + (e) + (when + (not (event-modifier-key? e)) + (prevent-default e) + (when + (not (dom-has-attr? el "sx-get")) + (dom-set-attr el "sx-get" href)) + (when + (not (dom-has-attr? el "sx-push-url")) + (dom-set-attr el "sx-push-url" "true")) + (execute-request el nil nil)))))) + (define + bind-boost-form + (fn + (form method action) + (dom-listen + form + "submit" + (fn (e) (prevent-default e) (execute-request form nil nil))))) + (define + bind-client-route-click + (fn + (link href fallback-fn) + (dom-listen + link + "click" + (fn + (e) + (when + (not (event-modifier-key? e)) + (prevent-default e) + (let + ((boost-el (dom-query "[sx-boost]")) + (target-sel + (if + boost-el + (let + ((attr (dom-get-attr boost-el "sx-boost"))) + (if + (and attr (not (= attr "true"))) + attr + "#sx-content")) + "#sx-content"))) + (if + (try-client-route (url-pathname href) target-sel) + (do + (save-scroll-position) + (browser-push-state nil "" href) + (browser-scroll-to 0 0)) + (do + (log-info (str "sx:route server fetch " href)) + (dom-set-attr link "sx-get" href) + (dom-set-attr link "sx-target" target-sel) + (dom-set-attr link "sx-select" target-sel) + (dom-set-attr link "sx-push-url" "true") + (execute-request link nil nil))))))))) + (define sw-post-message (fn (msg) nil)) + (define try-parse-json (fn (text) (json-parse text))) + (define + strip-component-scripts + (fn + (text) + (let + ((result text) + (start-tag "")) + (let + loop + ((s result)) + (let + ((start-idx (index-of s start-tag))) + (if + (= start-idx -1) + (set! result s) + (let + ((after-start (+ start-idx (len start-tag))) + (rest-str (slice s (+ start-idx (len start-tag))))) + (let + ((end-offset (index-of rest-str end-tag))) + (if + (= end-offset -1) + (set! result s) + (let + ((comp-text (slice rest-str 0 end-offset)) + (before (slice s 0 start-idx)) + (after + (slice rest-str (+ end-offset (len end-tag))))) + (sx-load-components comp-text) + (loop (str before after))))))))) + result))) + (define + extract-response-css + (fn + (text) + (let + ((result text) + (start-tag "")) + (let + loop + ((s result)) + (let + ((start-idx (index-of s start-tag))) + (if + (= start-idx -1) + (set! result s) + (let + ((rest-str (slice s (+ start-idx (len start-tag))))) + (let + ((end-offset (index-of rest-str end-tag))) + (if + (= end-offset -1) + (set! result s) + (let + ((css-text (slice rest-str 0 end-offset)) + (before (slice s 0 start-idx)) + (after + (slice rest-str (+ end-offset (len end-tag))))) + (let + ((doc (host-global "document")) + (style-el (host-call doc "createElement" "style"))) + (host-set! style-el "textContent" css-text) + (dom-append-to-head style-el)) + (loop (str before after))))))))) + result))) + (define + sx-render + (fn + (text) + (let + ((doc (host-global "document")) + (frag (host-call doc "createDocumentFragment")) + (exprs (sx-parse text))) + (scope-push! "sx-render-markers" true) + (for-each + (fn + (expr) + (let + ((result (try-catch (fn () (render-to-dom expr (get-render-env nil) nil)) (fn (err) (log-error (str "sx-render: " err)) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:4px;margin:0.25rem 0;") (dom-set-text-content el (str "Render error: " err)) el))))) (when result (dom-append frag result)))) exprs) - frag))))) - -(define - try-async-eval-content - (fn (content-src env callback) (try-eval-content content-src env))) - -(define try-rerender-page (fn () nil)) - -(define execute-action (fn () nil)) - -(define bind-preload (fn () nil)) - -(define persist-offline-data (fn () nil)) - -(define retrieve-offline-data (fn () nil)) - - -)) + (scope-pop! "sx-render-markers") + frag))) + (define + sx-hydrate + (fn (root) (sx-hydrate-elements (or root (dom-body))))) + (define + sx-process-scripts + (fn + (root) + (let + ((scripts (dom-query-all (or root (dom-body)) "script[type=\"text/sx\"]"))) + (for-each + (fn + (s) + (when + (not (is-processed? s "sx-script")) + (mark-processed! s "sx-script") + (let + ((text (host-get s "textContent"))) + (when + (and text (> (len text) 0)) + (let + ((exprs (sx-parse text))) + (for-each + (fn + (expr) + (try-catch + (fn () (cek-eval expr)) + (fn + (err) + (log-error (str "sx-process-scripts: " err))))) + exprs)))))) + scripts)))) + (define + select-from-container + (fn + (container selector) + (if + selector + (let + ((selected (dom-query container selector))) + (if + selected + (children-to-fragment selected) + (children-to-fragment container))) + (children-to-fragment container)))) + (define + children-to-fragment + (fn + (el) + (let + ((doc (host-global "document")) + (frag (host-call doc "createDocumentFragment"))) + (let + loop + () + (let + ((child (dom-first-child el))) + (when child (dom-append frag child) (loop)))) + frag))) + (define + select-html-from-doc + (fn + (doc selector) + (if + selector + (let + ((el (dom-query doc selector))) + (if el (dom-inner-html el) (dom-body-inner-html doc))) + (dom-body-inner-html doc)))) + (define register-io-deps (fn (deps) nil)) + (define resolve-page-data (fn (page-name params callback) nil)) + (define + parse-sx-data + (fn + (text) + (if + (and text (> (len text) 0)) + (let + ((exprs (sx-parse text))) + (if (not (empty? exprs)) (first exprs) nil)) + nil))) + (define + try-eval-content + (fn + (content-src env) + (let + ((exprs (sx-parse content-src))) + (if + (empty? exprs) + nil + (let + ((frag (create-fragment))) + (for-each + (fn + (expr) + (let + ((result (render-to-dom expr env nil))) + (when result (dom-append frag result)))) + exprs) + frag))))) + (define + try-async-eval-content + (fn (content-src env callback) (try-eval-content content-src env))) + (define try-rerender-page (fn () nil)) + (define execute-action (fn () nil)) + (define bind-preload (fn () nil)) + (define persist-offline-data (fn () nil)) + (define retrieve-offline-data (fn () nil)))) ;; Re-export to global env (import (web boot-helpers)) diff --git a/shared/static/wasm/sx/boot-helpers.sxbc b/shared/static/wasm/sx/boot-helpers.sxbc index 01ed7a07..03a0a062 100644 --- a/shared/static/wasm/sx/boot-helpers.sxbc +++ b/shared/static/wasm/sx/boot-helpers.sxbc @@ -1,3 +1,3 @@ -(sxbc 1 "355d9a273490ca7d" +(sxbc 1 "377849ee6503078e" (code - :constants ("_sx-bound-prefix" "_sxBound" "mark-processed!" {:upvalue-count 0 :arity 2 :constants ("host-set!" "str" "_sx-bound-prefix") :bytecode (20 0 0 16 0 20 2 0 16 1 52 1 0 2 3 49 3 50)} "is-processed?" {:upvalue-count 0 :arity 2 :constants ("host-get" "str" "_sx-bound-prefix") :bytecode (20 0 0 16 0 20 2 0 16 1 52 1 0 2 48 2 17 2 16 2 33 4 0 3 32 1 0 4 50)} "clear-processed!" {:upvalue-count 0 :arity 2 :constants ("host-set!" "str" "_sx-bound-prefix") :bytecode (20 0 0 16 0 20 2 0 16 1 52 1 0 2 2 49 3 50)} "callable?" {:upvalue-count 0 :arity 1 :constants ("type-of" "=" "lambda" "native-fn" "continuation") :bytecode (16 0 52 0 0 1 17 1 16 1 1 2 0 52 1 0 2 6 34 24 0 5 16 1 1 3 0 52 1 0 2 6 34 10 0 5 16 1 1 4 0 52 1 0 2 50)} "to-kebab" {:upvalue-count 0 :arity 1 :constants ("Convert camelCase to kebab-case." "list" 0 {:upvalue-count 3 :arity 1 :constants ("<" "len" "nth" ">=" "A" "<=" "Z" ">" 0 "append!" "-" "lower" "+" 1) :bytecode (16 0 18 0 52 1 0 1 52 0 0 2 33 102 0 18 0 16 0 52 2 0 2 17 1 16 1 1 4 0 52 3 0 2 6 33 10 0 5 16 1 1 6 0 52 5 0 2 33 41 0 16 0 1 8 0 52 7 0 2 33 12 0 18 1 1 10 0 52 9 0 2 32 1 0 2 5 18 1 16 1 52 11 0 1 52 9 0 2 32 8 0 18 1 16 1 52 9 0 2 5 18 2 16 0 1 13 0 52 12 0 2 49 1 32 1 0 2 50)} "join" "") :bytecode (1 0 0 5 52 1 0 0 17 1 1 2 0 17 2 2 17 3 51 3 0 1 0 1 1 1 3 17 3 16 3 1 2 0 48 1 5 1 5 0 16 1 52 4 0 2 50)} "sx-load-components" {:upvalue-count 0 :arity 1 :constants ("Parse and evaluate component definitions from text." ">" "len" 0 "sx-parse" "for-each" {:upvalue-count 0 :arity 1 :constants ("cek-eval") :bytecode (20 0 0 16 0 49 1 50)}) :bytecode (1 0 0 5 16 0 6 33 14 0 5 16 0 52 2 0 1 1 3 0 52 1 0 2 33 21 0 20 4 0 16 0 48 1 17 1 51 6 0 16 1 52 5 0 2 32 1 0 2 50)} "call-expr" {:upvalue-count 0 :arity 2 :constants ("Parse and evaluate an SX expression string." "sx-parse" "not" "empty?" "cek-eval" "first") :bytecode (1 0 0 5 20 1 0 16 0 48 1 17 2 16 2 52 3 0 1 52 2 0 1 33 14 0 20 4 0 16 2 52 5 0 1 49 1 32 1 0 2 50)} "base-env" {:upvalue-count 0 :arity 0 :constants ("Return the current global environment." "global-env") :bytecode (1 0 0 5 20 1 0 49 0 50)} "get-render-env" {:upvalue-count 0 :arity 1 :constants ("Get the rendering environment (global env, optionally merged with extra)." "base-env" "not" "nil?" "env-merge") :bytecode (1 0 0 5 20 1 0 48 0 17 1 16 0 6 33 11 0 5 16 0 52 3 0 1 52 2 0 1 33 11 0 16 1 16 0 52 4 0 2 32 2 0 16 1 50)} "merge-envs" {:upvalue-count 0 :arity 2 :constants ("Merge two environments." "env-merge" "global-env") :bytecode (1 0 0 5 16 0 6 33 3 0 5 16 1 33 11 0 16 0 16 1 52 1 0 2 32 19 0 16 0 6 34 13 0 5 16 1 6 34 6 0 5 20 2 0 49 0 50)} "sx-render-with-env" {:upvalue-count 0 :arity 2 :constants ("Parse SX source and render to DOM fragment." "host-global" "document" "host-call" "createDocumentFragment" "sx-parse" "for-each" {:upvalue-count 2 :arity 1 :constants ("render-to-html" ">" "len" 0 "host-call" "createElement" "template" "host-set!" "innerHTML" "appendChild" "host-get" "content") :bytecode (20 0 0 16 0 48 1 17 1 16 1 6 33 14 0 5 16 1 52 2 0 1 1 3 0 52 1 0 2 33 51 0 20 4 0 18 0 1 5 0 1 6 0 48 3 17 2 20 7 0 16 2 1 8 0 16 1 48 3 5 20 4 0 18 1 1 9 0 20 10 0 16 2 1 11 0 48 2 49 3 32 1 0 2 50)}) :bytecode (1 0 0 5 20 1 0 1 2 0 48 1 17 2 20 3 0 16 2 1 4 0 48 2 17 3 20 5 0 16 0 48 1 17 4 51 7 0 1 2 1 3 16 4 52 6 0 2 5 16 3 50)} "parse-env-attr" {:upvalue-count 0 :arity 1 :constants ("Parse data-sx-env attribute (JSON key-value pairs).") :bytecode (1 0 0 5 2 50)} "store-env-attr" {:upvalue-count 0 :arity 3 :constants () :bytecode (2 50)} "resolve-mount-target" {:upvalue-count 0 :arity 1 :constants ("Resolve a CSS selector string to a DOM element." "string?" "dom-query") :bytecode (1 0 0 5 16 0 52 1 0 1 33 10 0 20 2 0 16 0 49 1 32 2 0 16 0 50)} "remove-head-element" {:upvalue-count 0 :arity 1 :constants ("Remove a element matching selector." "dom-query" "dom-remove") :bytecode (1 0 0 5 20 1 0 16 0 48 1 17 1 16 1 33 10 0 20 2 0 16 1 49 1 32 1 0 2 50)} "set-sx-comp-cookie" {:upvalue-count 0 :arity 1 :constants ("set-cookie" "sx-components") :bytecode (1 1 0 16 0 52 0 0 2 50)} "clear-sx-comp-cookie" {:upvalue-count 0 :arity 0 :constants ("set-cookie" "sx-components" "") :bytecode (1 1 0 1 2 0 52 0 0 2 50)} "log-parse-error" {:upvalue-count 0 :arity 3 :constants ("log-error" "str" "Parse error in " ": ") :bytecode (20 0 0 1 2 0 16 0 1 3 0 16 2 52 1 0 4 49 1 50)} "loaded-component-names" {:upvalue-count 0 :arity 0 :constants ("dom-query-all" "dom-body" "script[data-components]" "list" "for-each" {:upvalue-count 1 :arity 1 :constants ("dom-get-attr" "data-components" "" ">" "len" 0 "for-each" {:upvalue-count 1 :arity 1 :constants (">" "len" "trim" 0 "append!") :bytecode (16 0 52 2 0 1 52 1 0 1 1 3 0 52 0 0 2 33 15 0 18 0 16 0 52 2 0 1 52 4 0 2 32 1 0 2 50)} "split" ",") :bytecode (20 0 0 16 0 1 1 0 48 2 6 34 4 0 5 1 2 0 17 1 16 1 52 4 0 1 1 5 0 52 3 0 2 33 21 0 51 7 0 0 0 16 1 1 9 0 52 8 0 2 52 6 0 2 32 1 0 2 50)}) :bytecode (20 0 0 20 1 0 48 0 1 2 0 48 2 17 0 52 3 0 0 17 1 51 5 0 1 1 16 0 52 4 0 2 5 16 1 50)} "csrf-token" {:upvalue-count 0 :arity 0 :constants ("dom-query" "meta[name=\"csrf-token\"]" "dom-get-attr" "content") :bytecode (20 0 0 1 1 0 48 1 17 0 16 0 33 13 0 20 2 0 16 0 1 3 0 49 2 32 1 0 2 50)} "validate-for-request" {:upvalue-count 0 :arity 1 :constants () :bytecode (3 50)} "build-request-body" {:upvalue-count 0 :arity 3 :constants ("upper" "=" "GET" "HEAD" "dom-tag-name" "" "FORM" "host-new" "FormData" "URLSearchParams" "host-call" "toString" "dict" "url" ">" "len" 0 "str" "contains?" "?" "&" "body" "content-type" "dom-get-attr" "enctype" "application/x-www-form-urlencoded" "multipart/form-data") :bytecode (16 1 52 0 0 1 17 3 16 3 1 2 0 52 1 0 2 6 34 10 0 5 16 3 1 3 0 52 1 0 2 33 167 0 16 0 6 33 27 0 5 20 4 0 16 0 48 1 6 34 4 0 5 1 5 0 52 0 0 1 1 6 0 52 1 0 2 33 111 0 20 7 0 1 8 0 16 0 48 2 17 4 20 7 0 1 9 0 16 4 48 2 17 5 20 10 0 16 5 1 11 0 48 2 17 6 1 13 0 16 6 6 33 14 0 5 16 6 52 15 0 1 1 16 0 52 14 0 2 33 32 0 16 2 16 2 1 19 0 52 18 0 2 33 6 0 1 20 0 32 3 0 1 19 0 16 6 52 17 0 3 32 2 0 16 2 1 21 0 2 1 22 0 2 52 12 0 6 32 17 0 1 13 0 16 2 1 21 0 2 1 22 0 2 52 12 0 6 32 173 0 16 0 6 33 27 0 5 20 4 0 16 0 48 1 6 34 4 0 5 1 5 0 52 0 0 1 1 6 0 52 1 0 2 33 120 0 20 23 0 16 0 1 24 0 48 2 6 34 4 0 5 1 25 0 17 4 16 4 1 26 0 52 1 0 2 33 33 0 20 7 0 1 8 0 16 0 48 2 17 5 1 13 0 16 2 1 21 0 16 5 1 22 0 2 52 12 0 6 32 52 0 20 7 0 1 8 0 16 0 48 2 17 5 20 7 0 1 9 0 16 5 48 2 17 6 1 13 0 16 2 1 21 0 20 10 0 16 6 1 11 0 48 2 1 22 0 1 25 0 52 12 0 6 32 17 0 1 13 0 16 2 1 21 0 2 1 22 0 2 52 12 0 6 50)} "abort-previous-target" {:upvalue-count 0 :arity 1 :constants () :bytecode (2 50)} "abort-previous" "track-controller" {:upvalue-count 0 :arity 2 :constants () :bytecode (2 50)} "track-controller-target" "new-abort-controller" {:upvalue-count 0 :arity 0 :constants ("host-new" "AbortController") :bytecode (20 0 0 1 1 0 49 1 50)} "abort-signal" {:upvalue-count 0 :arity 1 :constants ("host-get" "signal") :bytecode (20 0 0 16 0 1 1 0 49 2 50)} "apply-optimistic" "revert-optimistic" "dom-has-attr?" {:upvalue-count 0 :arity 2 :constants ("host-call" "hasAttribute") :bytecode (20 0 0 16 0 1 1 0 16 1 49 3 50)} "show-indicator" {:upvalue-count 0 :arity 1 :constants ("dom-get-attr" "sx-indicator" "dom-query" "dom-remove-class" "hidden" "dom-add-class" "sx-indicator-visible") :bytecode (20 0 0 16 0 1 1 0 48 2 17 1 16 1 33 42 0 20 2 0 16 1 48 1 17 2 16 2 33 24 0 20 3 0 16 2 1 4 0 48 2 5 20 5 0 16 2 1 6 0 48 2 32 1 0 2 32 1 0 2 5 16 1 50)} "disable-elements" {:upvalue-count 0 :arity 1 :constants ("dom-get-attr" "sx-disabled-elt" "dom-query-all" "dom-body" "for-each" {:upvalue-count 0 :arity 1 :constants ("dom-set-attr" "disabled" "") :bytecode (20 0 0 16 0 1 1 0 1 2 0 49 3 50)} "list") :bytecode (20 0 0 16 0 1 1 0 48 2 17 1 16 1 33 29 0 20 2 0 20 3 0 48 0 16 1 48 2 17 2 51 5 0 16 2 52 4 0 2 5 16 2 32 4 0 52 6 0 0 50)} "clear-loading-state" {:upvalue-count 0 :arity 3 :constants ("dom-remove-class" "sx-request" "dom-remove-attr" "aria-busy" "dom-query" "dom-add-class" "hidden" "sx-indicator-visible" "for-each" {:upvalue-count 0 :arity 1 :constants ("dom-remove-attr" "disabled") :bytecode (20 0 0 16 0 1 1 0 49 2 50)}) :bytecode (20 0 0 16 0 1 1 0 48 2 5 20 2 0 16 0 1 3 0 48 2 5 16 1 33 42 0 20 4 0 16 1 48 1 17 3 16 3 33 24 0 20 5 0 16 3 1 6 0 48 2 5 20 0 0 16 3 1 7 0 48 2 32 1 0 2 32 1 0 2 5 16 2 33 12 0 51 9 0 16 2 52 8 0 2 32 1 0 2 50)} "abort-error?" {:upvalue-count 0 :arity 1 :constants ("=" "host-get" "name" "AbortError") :bytecode (20 1 0 16 0 1 2 0 48 2 1 3 0 52 0 0 2 50)} "promise-catch" {:upvalue-count 0 :arity 2 :constants ("host-callback" "host-call" "catch") :bytecode (20 0 0 16 1 48 1 17 2 20 1 0 16 0 1 2 0 16 2 49 3 50)} "fetch-request" {:upvalue-count 0 :arity 3 :constants ("get" "url" "method" "GET" "headers" "dict" "body" "signal" "preloaded" 200 {:upvalue-count 0 :arity 1 :constants () :bytecode (2 50)} "host-new" "Headers" "Object" "for-each" {:upvalue-count 2 :arity 1 :constants ("host-call" "set" "get") :bytecode (20 0 0 18 0 1 1 0 16 0 18 1 16 0 52 2 0 2 49 4 50)} "keys" "host-set!" "promise-then" "host-call" "dom-window" "fetch" {:upvalue-count 2 :arity 1 :constants ("host-get" "ok" "status" {:upvalue-count 1 :arity 1 :constants ("host-call" "host-get" "headers" "get") :bytecode (20 0 0 20 1 0 18 0 1 2 0 48 2 1 3 0 16 0 49 3 50)} "promise-then" "host-call" "text" {:upvalue-count 4 :arity 1 :constants () :bytecode (18 0 18 1 18 2 18 3 16 0 49 4 50)}) :bytecode (20 0 0 16 0 1 1 0 48 2 17 1 20 0 0 16 0 1 2 0 48 2 17 2 51 3 0 1 0 17 3 20 4 0 20 5 0 16 0 1 6 0 48 2 51 7 0 0 0 1 1 1 2 1 3 18 1 49 3 50)}) :bytecode (16 0 1 1 0 52 0 0 2 17 3 16 0 1 2 0 52 0 0 2 6 34 4 0 5 1 3 0 17 4 16 0 1 4 0 52 0 0 2 6 34 5 0 5 52 5 0 0 17 5 16 0 1 6 0 52 0 0 2 17 6 16 0 1 7 0 52 0 0 2 17 7 16 0 1 8 0 52 0 0 2 17 8 16 8 33 16 0 16 1 3 1 9 0 51 10 0 16 8 49 4 32 139 0 20 11 0 1 12 0 48 1 17 9 20 11 0 1 13 0 48 1 17 10 51 15 0 1 9 1 5 16 5 52 16 0 1 52 14 0 2 5 20 17 0 16 10 1 2 0 16 4 48 3 5 20 17 0 16 10 1 4 0 16 9 48 3 5 16 6 33 15 0 20 17 0 16 10 1 6 0 16 6 48 3 32 1 0 2 5 16 7 33 15 0 20 17 0 16 10 1 7 0 16 7 48 3 32 1 0 2 5 20 18 0 20 19 0 20 20 0 48 0 1 21 0 16 3 16 10 48 4 51 22 0 1 1 1 2 16 2 49 3 50)} "fetch-location" {:upvalue-count 0 :arity 1 :constants ("dom-query" "[sx-boost]" "#main-panel" "browser-navigate") :bytecode (20 0 0 1 1 0 48 1 6 34 9 0 5 20 0 0 1 2 0 48 1 17 1 16 1 33 10 0 20 3 0 16 0 49 1 32 1 0 2 50)} "fetch-and-restore" {:upvalue-count 0 :arity 4 :constants ("fetch-request" "dict" "url" "method" "GET" "headers" "body" "signal" {:upvalue-count 2 :arity 4 :constants ("content-type" "" "contains?" "text/html" "host-new" "DOMParser" "host-call" "parseFromString" "querySelector" "#sx-content" "dom-set-inner-html" "host-get" "innerHTML" "dom-create-element" "div" "sx-render" "dom-append" "process-oob-swaps" {:upvalue-count 0 :arity 3 :constants ("dispose-islands-in" "swap-dom-nodes" "=" "innerHTML" "children-to-fragment" "post-swap") :bytecode (20 0 0 16 0 48 1 5 20 1 0 16 0 16 2 1 3 0 52 2 0 2 33 10 0 20 4 0 16 1 48 1 32 2 0 16 1 16 2 48 3 5 20 5 0 16 0 49 1 50)} "select-from-container" "dispose-islands-in" "dom-get-inner-html" "post-swap" "dom-window" "scrollTo" 0) :bytecode (16 0 33 1 1 16 2 1 0 0 48 1 6 34 4 0 5 1 1 0 17 4 16 4 1 3 0 52 2 0 2 33 79 0 20 4 0 1 5 0 48 1 17 5 20 6 0 16 5 1 7 0 16 3 1 3 0 48 4 17 6 20 6 0 16 6 1 8 0 1 9 0 48 3 17 7 16 7 33 20 0 20 10 0 18 0 20 11 0 16 7 1 12 0 48 2 48 2 32 9 0 20 10 0 18 0 16 3 48 2 32 119 0 20 13 0 1 14 0 48 1 17 5 20 15 0 16 3 48 1 17 6 16 6 33 94 0 20 16 0 16 5 16 6 48 2 5 20 17 0 16 5 51 18 0 48 2 5 20 19 0 16 5 1 9 0 48 2 17 7 16 7 33 31 0 20 20 0 18 0 48 1 5 20 10 0 18 0 1 1 0 48 2 5 20 16 0 18 0 16 7 48 2 32 22 0 20 20 0 18 0 48 1 5 20 10 0 18 0 20 21 0 16 5 48 1 48 2 32 1 0 2 5 20 22 0 18 0 48 1 5 20 6 0 20 23 0 48 0 1 24 0 1 25 0 18 1 49 4 32 1 0 2 50)} {:upvalue-count 0 :arity 1 :constants ("log-warn" "str" "fetch-and-restore error: ") :bytecode (20 0 0 1 2 0 16 0 52 1 0 2 49 1 50)}) :bytecode (20 0 0 1 2 0 16 1 1 3 0 1 4 0 1 5 0 16 2 1 6 0 2 1 7 0 2 52 1 0 10 51 8 0 1 0 1 3 51 9 0 49 3 50)} "fetch-preload" {:upvalue-count 0 :arity 3 :constants ("fetch-request" "dict" "url" "method" "GET" "headers" "body" "signal" {:upvalue-count 2 :arity 4 :constants ("preload-cache-set") :bytecode (16 0 33 14 0 20 0 0 18 0 18 1 16 3 49 3 32 1 0 2 50)} {:upvalue-count 0 :arity 1 :constants () :bytecode (2 50)}) :bytecode (20 0 0 1 2 0 16 0 1 3 0 1 4 0 1 5 0 16 1 1 6 0 2 1 7 0 2 52 1 0 10 51 8 0 1 2 1 0 51 9 0 49 3 50)} "fetch-streaming" {:upvalue-count 0 :arity 4 :constants ("fetch-and-restore" 0) :bytecode (20 0 0 16 0 16 1 16 2 1 1 0 49 4 50)} "dom-parse-html-document" {:upvalue-count 0 :arity 1 :constants ("host-new" "DOMParser" "host-call" "parseFromString" "text/html") :bytecode (20 0 0 1 1 0 48 1 17 1 20 2 0 16 1 1 3 0 16 0 1 4 0 49 4 50)} "dom-body-inner-html" {:upvalue-count 0 :arity 1 :constants ("host-get" "body" "innerHTML") :bytecode (20 0 0 20 0 0 16 0 1 1 0 48 2 1 2 0 49 2 50)} "create-script-clone" {:upvalue-count 0 :arity 1 :constants ("host-global" "document" "host-call" "createElement" "script" "host-get" "attributes" {:upvalue-count 3 :arity 1 :constants ("<" "host-get" "length" "host-call" "item" "setAttribute" "name" "value" "+" 1) :bytecode (16 0 20 1 0 18 0 1 2 0 48 2 52 0 0 2 33 61 0 20 3 0 18 0 1 4 0 16 0 48 3 17 1 20 3 0 18 1 1 5 0 20 1 0 16 1 1 6 0 48 2 20 1 0 16 1 1 7 0 48 2 48 4 5 18 2 16 0 1 9 0 52 8 0 2 49 1 32 1 0 2 50)} 0 "host-set!" "textContent") :bytecode (20 0 0 1 1 0 48 1 17 1 20 2 0 16 1 1 3 0 1 4 0 48 3 17 2 20 5 0 16 0 1 6 0 48 2 17 3 2 17 4 51 7 0 1 3 1 2 1 4 17 4 16 4 1 8 0 48 1 5 20 9 0 16 2 1 10 0 20 5 0 16 0 1 10 0 48 2 48 3 5 16 2 50)} "cross-origin?" {:upvalue-count 0 :arity 1 :constants ("starts-with?" "http://" "https://" "not" "browser-location-origin") :bytecode (16 0 1 1 0 52 0 0 2 6 34 10 0 5 16 0 1 2 0 52 0 0 2 33 18 0 16 0 20 4 0 48 0 52 0 0 2 52 3 0 1 32 1 0 4 50)} "browser-scroll-to" {:upvalue-count 0 :arity 2 :constants ("host-call" "dom-window" "scrollTo") :bytecode (20 0 0 20 1 0 48 0 1 2 0 16 0 16 1 49 4 50)} "with-transition" {:upvalue-count 0 :arity 2 :constants ("host-get" "host-global" "document" "startViewTransition" "host-call" "host-callback") :bytecode (16 0 6 33 17 0 5 20 0 0 20 1 0 1 2 0 48 1 1 3 0 48 2 33 26 0 20 4 0 20 1 0 1 2 0 48 1 1 3 0 20 5 0 16 1 48 1 49 3 32 4 0 16 1 49 0 50)} "event-source-connect" {:upvalue-count 0 :arity 2 :constants ("host-new" "EventSource" "host-set!" "_sxElement") :bytecode (20 0 0 1 1 0 16 0 48 2 17 2 20 2 0 16 2 1 3 0 16 1 48 3 5 16 2 50)} "event-source-listen" {:upvalue-count 0 :arity 3 :constants ("host-call" "addEventListener" "host-callback" {:upvalue-count 1 :arity 1 :constants () :bytecode (18 0 16 0 49 1 50)}) :bytecode (20 0 0 16 0 1 1 0 16 1 20 2 0 51 3 0 1 2 48 1 49 4 50)} "bind-boost-link" {:upvalue-count 0 :arity 2 :constants ("dom-listen" "click" {:upvalue-count 2 :arity 1 :constants ("not" "event-modifier-key?" "prevent-default" "dom-has-attr?" "sx-get" "dom-set-attr" "sx-push-url" "true" "execute-request") :bytecode (20 1 0 16 0 48 1 52 0 0 1 33 89 0 20 2 0 16 0 48 1 5 20 3 0 18 0 1 4 0 48 2 52 0 0 1 33 15 0 20 5 0 18 0 1 4 0 18 1 48 3 32 1 0 2 5 20 3 0 18 0 1 6 0 48 2 52 0 0 1 33 16 0 20 5 0 18 0 1 6 0 1 7 0 48 3 32 1 0 2 5 20 8 0 18 0 2 2 49 3 32 1 0 2 50)}) :bytecode (20 0 0 16 0 1 1 0 51 2 0 1 0 1 1 49 3 50)} "bind-boost-form" {:upvalue-count 0 :arity 3 :constants ("dom-listen" "submit" {:upvalue-count 1 :arity 1 :constants ("prevent-default" "execute-request") :bytecode (20 0 0 16 0 48 1 5 20 1 0 18 0 2 2 49 3 50)}) :bytecode (20 0 0 16 0 1 1 0 51 2 0 1 0 49 3 50)} "bind-client-route-click" {:upvalue-count 0 :arity 3 :constants ("dom-listen" "click" {:upvalue-count 2 :arity 1 :constants ("not" "event-modifier-key?" "prevent-default" "dom-query" "[sx-boost]" "dom-get-attr" "sx-boost" "=" "true" "#sx-content" "try-client-route" "url-pathname" "save-scroll-position" "browser-push-state" "" "browser-scroll-to" 0 "log-info" "str" "sx:route server fetch " "dom-set-attr" "sx-get" "sx-target" "sx-select" "sx-push-url" "execute-request") :bytecode (20 1 0 16 0 48 1 52 0 0 1 33 203 0 20 2 0 16 0 48 1 5 20 3 0 1 4 0 48 1 17 1 16 1 33 46 0 20 5 0 16 1 1 6 0 48 2 17 2 16 2 6 33 14 0 5 16 2 1 8 0 52 7 0 2 52 0 0 1 33 5 0 16 2 32 3 0 1 9 0 32 3 0 1 9 0 17 2 20 10 0 20 11 0 18 0 48 1 16 2 48 2 33 32 0 20 12 0 48 0 5 20 13 0 2 1 14 0 18 0 48 3 5 20 15 0 1 16 0 1 16 0 49 2 32 77 0 20 17 0 1 19 0 18 0 52 18 0 2 48 1 5 20 20 0 18 1 1 21 0 18 0 48 3 5 20 20 0 18 1 1 22 0 16 2 48 3 5 20 20 0 18 1 1 23 0 16 2 48 3 5 20 20 0 18 1 1 24 0 1 8 0 48 3 5 20 25 0 18 1 2 2 49 3 32 1 0 2 50)}) :bytecode (20 0 0 16 0 1 1 0 51 2 0 1 1 1 0 49 3 50)} "sw-post-message" "try-parse-json" {:upvalue-count 0 :arity 1 :constants ("json-parse") :bytecode (20 0 0 16 0 49 1 50)} "strip-component-scripts" {:upvalue-count 0 :arity 1 :constants ("")) - (let - loop - ((s result)) + (expr-text env-bindings) + "Parse and evaluate an SX expression string." (let - ((start-idx (index-of s start-tag))) - (if - (= start-idx -1) - (set! result s) - (let - ((after-start (+ start-idx (len start-tag))) - (rest-str (slice s (+ start-idx (len start-tag))))) - (let - ((end-offset (index-of rest-str end-tag))) - (if - (= end-offset -1) - (set! result s) - (let - ((comp-text (slice rest-str 0 end-offset)) - (before (slice s 0 start-idx)) - (after (slice rest-str (+ end-offset (len end-tag))))) - (sx-load-components comp-text) - (loop (str before after))))))))) - result))) - -(define - extract-response-css - (fn - (text) - (let - ((result text) (start-tag "")) - (let - loop - ((s result)) + ((exprs (sx-parse expr-text))) + (when (not (empty? exprs)) (cek-eval (first exprs)))))) + (define + base-env + (fn () "Return the current global environment." (global-env))) + (define + get-render-env + (fn + (extra) + "Get the rendering environment (global env, optionally merged with extra)." (let - ((start-idx (index-of s start-tag))) - (if - (= start-idx -1) - (set! result s) - (let - ((rest-str (slice s (+ start-idx (len start-tag))))) - (let - ((end-offset (index-of rest-str end-tag))) - (if - (= end-offset -1) - (set! result s) - (let - ((css-text (slice rest-str 0 end-offset)) - (before (slice s 0 start-idx)) - (after (slice rest-str (+ end-offset (len end-tag))))) - (let - ((doc (host-global "document")) - (style-el (host-call doc "createElement" "style"))) - (host-set! style-el "textContent" css-text) - (dom-append-to-head style-el)) - (loop (str before after))))))))) - result))) - -(define - sx-render - (fn - (text) - (let - ((doc (host-global "document")) - (frag (host-call doc "createDocumentFragment")) - (exprs (sx-parse text))) - (scope-push! "sx-render-markers" true) - (for-each - (fn - (expr) - (let - ((result (try-catch (fn () (render-to-dom expr (get-render-env nil) nil)) (fn (err) (log-error (str "sx-render: " err)) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:4px;margin:0.25rem 0;") (dom-set-text-content el (str "Render error: " err)) el))))) - (when result (dom-append frag result)))) - exprs) - (scope-pop! "sx-render-markers") - frag))) - -(define sx-hydrate (fn (root) (sx-hydrate-elements (or root (dom-body))))) - -(define - sx-process-scripts - (fn - (root) - (let - ((scripts (dom-query-all (or root (dom-body)) "script[type=\"text/sx\"]"))) - (for-each - (fn - (s) - (when - (not (is-processed? s "sx-script")) - (mark-processed! s "sx-script") - (let - ((text (host-get s "textContent"))) - (when - (and text (> (len text) 0)) - (let - ((exprs (sx-parse text))) - (for-each - (fn - (expr) - (try-catch - (fn () (cek-eval expr)) - (fn - (err) - (log-error (str "sx-process-scripts: " err))))) - exprs)))))) - scripts)))) - -(define - select-from-container - (fn - (container selector) - (if - selector - (let - ((selected (dom-query container selector))) - (if - selected - (children-to-fragment selected) - (children-to-fragment container))) - (children-to-fragment container)))) - -(define - children-to-fragment - (fn - (el) - (let - ((doc (host-global "document")) - (frag (host-call doc "createDocumentFragment"))) - (let - loop - () + ((env (base-env))) + (if (and extra (not (nil? extra))) (env-merge env extra) env)))) + (define + merge-envs + (fn + (a b) + "Merge two environments." + (if (and a b) (env-merge a b) (or a b (global-env))))) + (define + sx-render-with-env + (fn + (source extra-env) + "Parse SX source and render to DOM fragment." (let - ((child (dom-first-child el))) - (when child (dom-append frag child) (loop)))) - frag))) - -(define - select-html-from-doc - (fn - (doc selector) - (if - selector - (let - ((el (dom-query doc selector))) - (if el (dom-inner-html el) (dom-body-inner-html doc))) - (dom-body-inner-html doc)))) - -(define register-io-deps (fn (deps) nil)) - -(define resolve-page-data (fn (page-name params callback) nil)) - -(define - parse-sx-data - (fn - (text) - (if - (and text (> (len text) 0)) - (let - ((exprs (sx-parse text))) - (if (not (empty? exprs)) (first exprs) nil)) - nil))) - -(define - try-eval-content - (fn - (content-src env) - (let - ((exprs (sx-parse content-src))) - (if - (empty? exprs) - nil - (let - ((frag (create-fragment))) + ((doc (host-global "document")) + (frag (host-call doc "createDocumentFragment")) + (exprs (sx-parse source))) (for-each (fn (expr) (let - ((result (render-to-dom expr env nil))) + ((html (render-to-html expr))) + (when + (and html (> (len html) 0)) + (let + ((temp (host-call doc "createElement" "template"))) + (host-set! temp "innerHTML" html) + (host-call frag "appendChild" (host-get temp "content")))))) + exprs) + frag))) + (define + parse-env-attr + (fn (el) "Parse data-sx-env attribute (JSON key-value pairs)." nil)) + (define store-env-attr (fn (el base new-env) nil)) + (define + resolve-mount-target + (fn + (target) + "Resolve a CSS selector string to a DOM element." + (if (string? target) (dom-query target) target))) + (define + remove-head-element + (fn + (sel) + "Remove a element matching selector." + (let ((el (dom-query sel))) (when el (dom-remove el))))) + (define + set-sx-comp-cookie + (fn (hash) (set-cookie "sx-components" hash))) + (define clear-sx-comp-cookie (fn () (set-cookie "sx-components" ""))) + (define + log-parse-error + (fn + (label text err) + (log-error (str "Parse error in " label ": " err)))) + (define + loaded-component-names + (fn + () + (let + ((scripts (dom-query-all (dom-body) "script[data-components]")) + (names (list))) + (for-each + (fn + (script) + (let + ((text (or (dom-get-attr script "data-components") ""))) + (when + (> (len text) 0) + (for-each + (fn + (name) + (when + (> (len (trim name)) 0) + (append! names (trim name)))) + (split text ","))))) + scripts) + names))) + (define + csrf-token + (fn + () + (let + ((meta (dom-query "meta[name=\"csrf-token\"]"))) + (if meta (dom-get-attr meta "content") nil)))) + (define validate-for-request (fn (el) true)) + (define + build-request-body + (fn + (el method url) + (let + ((m (upper method))) + (if + (or (= m "GET") (= m "HEAD")) + (if + (and el (= (upper (or (dom-tag-name el) "")) "FORM")) + (let + ((fd (host-new "FormData" el)) + (params (host-new "URLSearchParams" fd)) + (qs (host-call params "toString"))) + (dict + "url" + (if + (and qs (> (len qs) 0)) + (str url (if (contains? url "?") "&" "?") qs) + url) + "body" + nil + "content-type" + nil)) + (dict "url" url "body" nil "content-type" nil)) + (if + (and el (= (upper (or (dom-tag-name el) "")) "FORM")) + (let + ((enctype (or (dom-get-attr el "enctype") "application/x-www-form-urlencoded"))) + (if + (= enctype "multipart/form-data") + (let + ((fd (host-new "FormData" el))) + (dict "url" url "body" fd "content-type" nil)) + (let + ((fd (host-new "FormData" el)) + (params (host-new "URLSearchParams" fd))) + (dict + "url" + url + "body" + (host-call params "toString") + "content-type" + "application/x-www-form-urlencoded")))) + (dict "url" url "body" nil "content-type" nil)))))) + (define abort-previous-target (fn (el) nil)) + (define abort-previous (fn (el) nil)) + (define track-controller (fn (el ctrl) nil)) + (define track-controller-target (fn (el ctrl) nil)) + (define new-abort-controller (fn () (host-new "AbortController"))) + (define abort-signal (fn (ctrl) (host-get ctrl "signal"))) + (define apply-optimistic (fn (el) nil)) + (define revert-optimistic (fn (el) nil)) + (define dom-has-attr? (fn (el name) (host-call el "hasAttribute" name))) + (define + show-indicator + (fn + (el) + (let + ((indicator-sel (dom-get-attr el "sx-indicator"))) + (when + indicator-sel + (let + ((indicator (dom-query indicator-sel))) + (when + indicator + (dom-remove-class indicator "hidden") + (dom-add-class indicator "sx-indicator-visible")))) + indicator-sel))) + (define + disable-elements + (fn + (el) + (let + ((disable-sel (dom-get-attr el "sx-disabled-elt"))) + (if + disable-sel + (let + ((elts (dom-query-all (dom-body) disable-sel))) + (for-each (fn (e) (dom-set-attr e "disabled" "")) elts) + elts) + (list))))) + (define + clear-loading-state + (fn + (el indicator disabled-elts) + (dom-remove-class el "sx-request") + (dom-remove-attr el "aria-busy") + (when + indicator + (let + ((ind (dom-query indicator))) + (when + ind + (dom-add-class ind "hidden") + (dom-remove-class ind "sx-indicator-visible")))) + (when + disabled-elts + (for-each (fn (e) (dom-remove-attr e "disabled")) disabled-elts)))) + (define abort-error? (fn (err) (= (host-get err "name") "AbortError"))) + (define + promise-catch + (fn (p f) (let ((cb (host-callback f))) (host-call p "catch" cb)))) + (define + fetch-request + (fn + (config success-fn error-fn) + (let + ((url (get config "url")) + (method (or (get config "method") "GET")) + (headers (or (get config "headers") (dict))) + (body (get config "body")) + (signal (get config "signal")) + (preloaded (get config "preloaded"))) + (if + preloaded + (success-fn true 200 (fn (name) nil) preloaded) + (let + ((h (host-new "Headers")) (js-opts (host-new "Object"))) + (for-each + (fn (k) (host-call h "set" k (get headers k))) + (keys headers)) + (host-set! js-opts "method" method) + (host-set! js-opts "headers" h) + (when body (host-set! js-opts "body" body)) + (when signal (host-set! js-opts "signal" signal)) + (promise-then + (host-call (dom-window) "fetch" url js-opts) + (fn + (response) + (let + ((ok (host-get response "ok")) + (status (host-get response "status")) + (get-header + (fn + (name) + (host-call (host-get response "headers") "get" name)))) + (promise-then + (host-call response "text") + (fn (text) (success-fn ok status get-header text)) + error-fn))) + error-fn)))))) + (define + fetch-location + (fn + (url) + (let + ((target (or (dom-query "[sx-boost]") (dom-query "#main-panel")))) + (when target (browser-navigate url))))) + (define + fetch-and-restore + (fn + (main url headers scroll-y) + (fetch-request + (dict + "url" + url + "method" + "GET" + "headers" + headers + "body" + nil + "signal" + nil) + (fn + (resp-ok status get-header text) + (when + resp-ok + (let + ((ct (or (get-header "content-type") ""))) + (if + (contains? ct "text/html") + (let + ((parser (host-new "DOMParser")) + (doc + (host-call parser "parseFromString" text "text/html")) + (content (host-call doc "querySelector" "#sx-content"))) + (if + content + (dom-set-inner-html main (host-get content "innerHTML")) + (dom-set-inner-html main text))) + (let + ((container (dom-create-element "div"))) + (let + ((rendered (sx-render text))) + (when + rendered + (dom-append container rendered) + (process-oob-swaps + container + (fn + (t oob (s :as string)) + (dispose-islands-in t) + (swap-dom-nodes + t + (if + (= s "innerHTML") + (children-to-fragment oob) + oob) + s) + (post-swap t))) + (let + ((content (select-from-container container "#sx-content"))) + (if + content + (do + (dispose-islands-in main) + (dom-set-inner-html main "") + (dom-append main content)) + (do + (dispose-islands-in main) + (dom-set-inner-html + main + (dom-get-inner-html container)))))))))) + (post-swap main) + (host-call (dom-window) "scrollTo" 0 scroll-y))) + (fn (err) (log-warn (str "fetch-and-restore error: " err)))))) + (define + fetch-preload + (fn + (url headers cache) + (fetch-request + (dict + "url" + url + "method" + "GET" + "headers" + headers + "body" + nil + "signal" + nil) + (fn + (resp-ok status get-header text) + (when resp-ok (preload-cache-set cache url text))) + (fn (err) nil)))) + (define + fetch-streaming + (fn + (target pathname headers swap-fn) + (fetch-and-restore target pathname headers 0))) + (define + dom-parse-html-document + (fn + (text) + (let + ((parser (host-new "DOMParser"))) + (host-call parser "parseFromString" text "text/html")))) + (define + dom-body-inner-html + (fn (doc) (host-get (host-get doc "body") "innerHTML"))) + (define + create-script-clone + (fn + (dead) + (let + ((doc (host-global "document")) + (live (host-call doc "createElement" "script"))) + (let + ((attrs (host-get dead "attributes"))) + (let + loop + ((i 0)) + (when + (< i (host-get attrs "length")) + (let + ((attr (host-call attrs "item" i))) + (host-call + live + "setAttribute" + (host-get attr "name") + (host-get attr "value")) + (loop (+ i 1)))))) + (host-set! live "textContent" (host-get dead "textContent")) + live))) + (define + cross-origin? + (fn + (url) + (if + (or (starts-with? url "http://") (starts-with? url "https://")) + (not (starts-with? url (browser-location-origin))) + false))) + (define + browser-scroll-to + (fn (x y) (host-call (dom-window) "scrollTo" x y))) + (define + with-transition + (fn + (enabled thunk) + (if + (and + enabled + (host-get (host-global "document") "startViewTransition")) + (host-call + (host-global "document") + "startViewTransition" + (host-callback thunk)) + (thunk)))) + (define + event-source-connect + (fn + (url el) + (let + ((source (host-new "EventSource" url))) + (host-set! source "_sxElement" el) + source))) + (define + event-source-listen + (fn + (source event-name handler) + (host-call + source + "addEventListener" + event-name + (host-callback (fn (e) (handler e)))))) + (define + bind-boost-link + (fn + (el href) + (dom-listen + el + "click" + (fn + (e) + (when + (not (event-modifier-key? e)) + (prevent-default e) + (when + (not (dom-has-attr? el "sx-get")) + (dom-set-attr el "sx-get" href)) + (when + (not (dom-has-attr? el "sx-push-url")) + (dom-set-attr el "sx-push-url" "true")) + (execute-request el nil nil)))))) + (define + bind-boost-form + (fn + (form method action) + (dom-listen + form + "submit" + (fn (e) (prevent-default e) (execute-request form nil nil))))) + (define + bind-client-route-click + (fn + (link href fallback-fn) + (dom-listen + link + "click" + (fn + (e) + (when + (not (event-modifier-key? e)) + (prevent-default e) + (let + ((boost-el (dom-query "[sx-boost]")) + (target-sel + (if + boost-el + (let + ((attr (dom-get-attr boost-el "sx-boost"))) + (if + (and attr (not (= attr "true"))) + attr + "#sx-content")) + "#sx-content"))) + (if + (try-client-route (url-pathname href) target-sel) + (do + (save-scroll-position) + (browser-push-state nil "" href) + (browser-scroll-to 0 0)) + (do + (log-info (str "sx:route server fetch " href)) + (dom-set-attr link "sx-get" href) + (dom-set-attr link "sx-target" target-sel) + (dom-set-attr link "sx-select" target-sel) + (dom-set-attr link "sx-push-url" "true") + (execute-request link nil nil))))))))) + (define sw-post-message (fn (msg) nil)) + (define try-parse-json (fn (text) (json-parse text))) + (define + strip-component-scripts + (fn + (text) + (let + ((result text) + (start-tag "")) + (let + loop + ((s result)) + (let + ((start-idx (index-of s start-tag))) + (if + (= start-idx -1) + (set! result s) + (let + ((after-start (+ start-idx (len start-tag))) + (rest-str (slice s (+ start-idx (len start-tag))))) + (let + ((end-offset (index-of rest-str end-tag))) + (if + (= end-offset -1) + (set! result s) + (let + ((comp-text (slice rest-str 0 end-offset)) + (before (slice s 0 start-idx)) + (after + (slice rest-str (+ end-offset (len end-tag))))) + (sx-load-components comp-text) + (loop (str before after))))))))) + result))) + (define + extract-response-css + (fn + (text) + (let + ((result text) + (start-tag "")) + (let + loop + ((s result)) + (let + ((start-idx (index-of s start-tag))) + (if + (= start-idx -1) + (set! result s) + (let + ((rest-str (slice s (+ start-idx (len start-tag))))) + (let + ((end-offset (index-of rest-str end-tag))) + (if + (= end-offset -1) + (set! result s) + (let + ((css-text (slice rest-str 0 end-offset)) + (before (slice s 0 start-idx)) + (after + (slice rest-str (+ end-offset (len end-tag))))) + (let + ((doc (host-global "document")) + (style-el (host-call doc "createElement" "style"))) + (host-set! style-el "textContent" css-text) + (dom-append-to-head style-el)) + (loop (str before after))))))))) + result))) + (define + sx-render + (fn + (text) + (let + ((doc (host-global "document")) + (frag (host-call doc "createDocumentFragment")) + (exprs (sx-parse text))) + (scope-push! "sx-render-markers" true) + (for-each + (fn + (expr) + (let + ((result (try-catch (fn () (render-to-dom expr (get-render-env nil) nil)) (fn (err) (log-error (str "sx-render: " err)) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:4px;margin:0.25rem 0;") (dom-set-text-content el (str "Render error: " err)) el))))) (when result (dom-append frag result)))) exprs) - frag))))) - -(define - try-async-eval-content - (fn (content-src env callback) (try-eval-content content-src env))) - -(define try-rerender-page (fn () nil)) - -(define execute-action (fn () nil)) - -(define bind-preload (fn () nil)) - -(define persist-offline-data (fn () nil)) - -(define retrieve-offline-data (fn () nil)) - - -)) + (scope-pop! "sx-render-markers") + frag))) + (define + sx-hydrate + (fn (root) (sx-hydrate-elements (or root (dom-body))))) + (define + sx-process-scripts + (fn + (root) + (let + ((scripts (dom-query-all (or root (dom-body)) "script[type=\"text/sx\"]"))) + (for-each + (fn + (s) + (when + (not (is-processed? s "sx-script")) + (mark-processed! s "sx-script") + (let + ((text (host-get s "textContent"))) + (when + (and text (> (len text) 0)) + (let + ((exprs (sx-parse text))) + (for-each + (fn + (expr) + (try-catch + (fn () (cek-eval expr)) + (fn + (err) + (log-error (str "sx-process-scripts: " err))))) + exprs)))))) + scripts)))) + (define + select-from-container + (fn + (container selector) + (if + selector + (let + ((selected (dom-query container selector))) + (if + selected + (children-to-fragment selected) + (children-to-fragment container))) + (children-to-fragment container)))) + (define + children-to-fragment + (fn + (el) + (let + ((doc (host-global "document")) + (frag (host-call doc "createDocumentFragment"))) + (let + loop + () + (let + ((child (dom-first-child el))) + (when child (dom-append frag child) (loop)))) + frag))) + (define + select-html-from-doc + (fn + (doc selector) + (if + selector + (let + ((el (dom-query doc selector))) + (if el (dom-inner-html el) (dom-body-inner-html doc))) + (dom-body-inner-html doc)))) + (define register-io-deps (fn (deps) nil)) + (define resolve-page-data (fn (page-name params callback) nil)) + (define + parse-sx-data + (fn + (text) + (if + (and text (> (len text) 0)) + (let + ((exprs (sx-parse text))) + (if (not (empty? exprs)) (first exprs) nil)) + nil))) + (define + try-eval-content + (fn + (content-src env) + (let + ((exprs (sx-parse content-src))) + (if + (empty? exprs) + nil + (let + ((frag (create-fragment))) + (for-each + (fn + (expr) + (let + ((result (render-to-dom expr env nil))) + (when result (dom-append frag result)))) + exprs) + frag))))) + (define + try-async-eval-content + (fn (content-src env callback) (try-eval-content content-src env))) + (define try-rerender-page (fn () nil)) + (define execute-action (fn () nil)) + (define bind-preload (fn () nil)) + (define persist-offline-data (fn () nil)) + (define retrieve-offline-data (fn () nil)))) ;; Re-export to global env (import (web boot-helpers))