;; boot-helpers.sx — Platform helpers for boot/orchestration/engine ;; ;; These were JS-native functions in the transpiled bundle. Now pure SX ;; built on the 8 FFI host primitives + dom.sx/browser.sx. ;; -------------------------------------------------------------------------- ;; Processing markers — track which DOM elements have been bound/hydrated ;; -------------------------------------------------------------------------- (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))) ;; -------------------------------------------------------------------------- ;; Callable check ;; -------------------------------------------------------------------------- (define callable? (fn (v) (let ((t (type-of v))) (or (= t "lambda") (= t "native-fn") (= t "continuation"))))) ;; -------------------------------------------------------------------------- ;; String helpers ;; -------------------------------------------------------------------------- (define to-kebab (fn (s) "Convert camelCase to kebab-case." (let ((result (list)) (i 0)) (let loop ((i 0)) (when (< i (len s)) (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)))) ;; -------------------------------------------------------------------------- ;; Component / rendering helpers ;; -------------------------------------------------------------------------- (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 &rest 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 (&rest extra) "Get the rendering environment (global env, optionally merged with extra)." (let ((env (global-env))) (if (and extra (not (nil? (first extra))) (not (empty? extra))) (env-merge env (first 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))) (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))))) ;; -------------------------------------------------------------------------- ;; Cookie helpers for component caching ;; -------------------------------------------------------------------------- (define set-sx-comp-cookie (fn (hash) (set-cookie "sx-components" hash))) (define clear-sx-comp-cookie (fn () (set-cookie "sx-components" ""))) ;; -------------------------------------------------------------------------- ;; Logging ;; -------------------------------------------------------------------------- (define log-parse-error (fn (label text err) (log-error (str "Parse error in " label ": " err)))) ;; -------------------------------------------------------------------------- ;; Validation stub (orchestration.sx needs this) ;; -------------------------------------------------------------------------- ;; -------------------------------------------------------------------------- ;; Loaded component tracking ;; -------------------------------------------------------------------------- ;; ;; Returns names of components/islands loaded client-side. ;; build-request-headers uses a DOM hash instead of this list, ;; and deps-satisfied? falls back to server fetch when empty. (define loaded-component-names (fn () ;; Scan data-components script tags for loaded component names (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))) ;; -------------------------------------------------------------------------- ;; CSRF token ;; -------------------------------------------------------------------------- (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)) ;; -------------------------------------------------------------------------- ;; Request body builder ;; -------------------------------------------------------------------------- ;; ;; For GET/HEAD: no body. If element is a form, serialize inputs as query params. ;; For POST/PUT/etc: if element is a form, build FormData body. ;; Returns dict with "url", "body", "content-type". (define build-request-body (fn (el method url) (let ((m (upper method))) (if (or (= m "GET") (= m "HEAD")) ;; GET/HEAD — serialize form inputs into URL query params (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)) ;; POST/PUT/etc — build form body if element is a form (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") ;; Multipart: let browser set Content-Type with boundary (let ((fd (host-new "FormData" el))) (dict "url" url "body" fd "content-type" nil)) ;; URL-encoded (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")))) ;; Not a form — no body (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)) ;; -------------------------------------------------------------------------- ;; DOM query helpers (used by boot.sx) ;; -------------------------------------------------------------------------- (define dom-has-attr? (fn (el name) (host-call el "hasAttribute" name))) ;; -------------------------------------------------------------------------- ;; Loading state (indicators, disabling) ;; -------------------------------------------------------------------------- (define show-indicator (fn (el) ;; Show loading indicator. Returns indicator state for cleanup. (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) ;; Disable elements during request. Returns list of disabled elements. (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) ;; Reverse loading state: hide indicator, re-enable elements (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)))) ;; -------------------------------------------------------------------------- ;; Abort / error helpers ;; -------------------------------------------------------------------------- (define abort-error? (fn (err) (= (host-get err "name") "AbortError"))) ;; -------------------------------------------------------------------------- ;; Promise helpers ;; -------------------------------------------------------------------------- (define promise-catch (fn (p f) (let ((cb (host-callback f))) (host-call p "catch" cb)))) ;; -------------------------------------------------------------------------- ;; Fetch helpers ;; -------------------------------------------------------------------------- ;; Override browser.sx's raw fetch-request with the higher-level interface ;; that orchestration expects: (fetch-request config success-fn error-fn) ;; config: dict with url, method, headers, body, signal, cross-origin, preloaded ;; success-fn: (fn (resp-ok status get-header text) ...) ;; error-fn: (fn (err) ...) (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 content is available, use it directly (if preloaded (success-fn true 200 (fn (name) nil) preloaded) ;; Build fetch options as plain JS object (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)) ;; Execute fetch (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) ;; Navigate to URL via fetch + swap into boost target (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) ;; Popstate: fetch URL, swap into main, restore scroll (fetch-request (dict "url" url "method" "GET" "headers" headers "body" nil "signal" nil) (fn (resp-ok status get-header text) (when resp-ok (dom-set-inner-html main text) (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) ;; Preload URL into cache dict (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) ;; Streaming fetch — fallback to non-streaming (fetch-and-restore target pathname headers 0))) ;; -------------------------------------------------------------------------- ;; DOM extras ;; -------------------------------------------------------------------------- (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"))) ;; Copy attributes (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)))))) ;; Copy content (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))) ;; -------------------------------------------------------------------------- ;; View transitions ;; -------------------------------------------------------------------------- (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)))) ;; -------------------------------------------------------------------------- ;; IntersectionObserver ;; -------------------------------------------------------------------------- (define observe-intersection (fn (el callback once? delay) (let ((cb (host-callback (fn (entries) (for-each (fn (entry) (when (host-get entry "isIntersecting") (if delay (set-timeout (fn () (callback entry)) delay) (callback entry)) (when once? (host-call observer "unobserve" el)))) (host-call entries "forEach" (host-callback (fn (e) e)))))))) ;; Direct approach: create observer that calls back for each entry (let ((observer (host-new "IntersectionObserver" (host-callback (fn (entries) (let ((arr-len (host-get entries "length"))) (let loop ((i 0)) (when (< i arr-len) (let ((entry (host-call entries "item" i))) (when (and entry (host-get entry "isIntersecting")) (if delay (set-timeout (fn () (callback entry)) delay) (callback entry)) (when once? (host-call observer "unobserve" el)))) (loop (+ i 1)))))))))) (host-call observer "observe" el) observer)))) ;; -------------------------------------------------------------------------- ;; EventSource (SSE) ;; -------------------------------------------------------------------------- (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)))))) ;; -------------------------------------------------------------------------- ;; Boost bindings ;; -------------------------------------------------------------------------- (define bind-boost-link (fn (el href) (dom-listen el "click" (fn (e) (when (not (event-modifier-key? e)) (prevent-default e) ;; Set verb attrs so execute-request can process this as a GET (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) ;; Try client routing first, fall back to server fetch (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 "#main-panel")) "#main-panel"))) (if (try-client-route (url-pathname href) target-sel) (do (browser-push-state nil "" href) (browser-scroll-to 0 0)) ;; Fallback: server fetch via execute-request (do (when (not (dom-has-attr? link "sx-get")) (dom-set-attr link "sx-get" href)) (when (not (dom-has-attr? link "sx-push-url")) (dom-set-attr link "sx-push-url" "true")) (execute-request link nil nil))))))))) ;; -------------------------------------------------------------------------- ;; Service worker ;; -------------------------------------------------------------------------- (define sw-post-message (fn (msg) nil)) ;; -------------------------------------------------------------------------- ;; Response processing (fetch/swap pipeline) ;; -------------------------------------------------------------------------- (define try-parse-json (fn (text) (json-parse text))) (define strip-component-scripts (fn (text) ;; Remove from response text. ;; The text may be SX (not valid HTML), so use string matching. ;; First, load the component definitions into the environment. (let ((result text) (start-tag "")) ;; Find and extract component scripts (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))))) ;; Load component definitions (sx-load-components comp-text) (loop (str before after))))))))) result))) (define extract-response-css (fn (text) ;; Extract tags from response text. ;; Apply them to the document head, return remaining 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))))) ;; Apply CSS to head (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) ;; Parse SX text and render to a DOM fragment. ;; Islands are rendered as empty markers (span with data-sx-island) ;; — post-swap will hydrate them. This matches the server's aser mode ;; where island calls are serialized without expansion. (let ((doc (host-global "document")) (frag (host-call doc "createDocumentFragment")) (exprs (sx-parse text))) ;; Push marker mode: render-dom-island creates markers, not full renders (scope-push! "sx-render-markers" true) (for-each (fn (expr) (let ((result (render-to-dom expr (get-render-env nil) nil))) (when result (dom-append frag result)))) exprs) (scope-pop! "sx-render-markers") frag))) (define sx-hydrate (fn (root) ;; Hydrate data-sx elements in root (or document). (sx-hydrate-elements (or root (dom-body))))) (define sx-process-scripts (fn (root) ;; Find and evaluate