Files
rose-ash/shared/sx/ref/boot.sx
giles 1d1e7f30bb Add flush-cssx-to-dom: client-side CSSX rule injection
Islands render independently on the client, so ~cssx/tw calls
collect!("cssx", rule) but no ~cssx/flush runs. Add flush-cssx-to-dom
in boot.sx that injects collected rules into a persistent <style>
element in <head>.

Called at all lifecycle points: boot-init, sx-mount, resolve-suspense,
post-swap (navigation morph), and swap-rendered-content (client routes).

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
2026-03-13 04:09:23 +00:00

548 lines
22 KiB
Plaintext

;; ==========================================================================
;; boot.sx — Browser boot, mount, hydrate, script processing
;;
;; Handles the browser startup lifecycle:
;; 1. CSS tracking init
;; 2. Component script processing (from <script type="text/sx">)
;; 3. Hydration of [data-sx] elements
;; 4. Engine element processing
;;
;; Also provides the public mounting/hydration API:
;; mount, hydrate, update, render-component
;;
;; Depends on:
;; orchestration.sx — process-elements, engine-init
;; adapter-dom.sx — render-to-dom
;; render.sx — shared registries
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Head element hoisting (full version)
;; --------------------------------------------------------------------------
;; Moves <meta>, <title>, <link rel=canonical>, <script type=application/ld+json>
;; from rendered content to <head>, deduplicating as needed.
(define HEAD_HOIST_SELECTOR
"meta, title, link[rel='canonical'], script[type='application/ld+json']")
(define hoist-head-elements-full :effects [mutation io]
(fn (root)
(let ((els (dom-query-all root HEAD_HOIST_SELECTOR)))
(for-each
(fn (el)
(let ((tag (lower (dom-tag-name el))))
(cond
;; <title> — replace document title
(= tag "title")
(do
(set-document-title (dom-text-content el))
(dom-remove-child (dom-parent el) el))
;; <meta> — deduplicate by name or property
(= tag "meta")
(do
(let ((name (dom-get-attr el "name"))
(prop (dom-get-attr el "property")))
(when name
(remove-head-element (str "meta[name=\"" name "\"]")))
(when prop
(remove-head-element (str "meta[property=\"" prop "\"]"))))
(dom-remove-child (dom-parent el) el)
(dom-append-to-head el))
;; <link rel=canonical> — deduplicate
(and (= tag "link")
(= (dom-get-attr el "rel") "canonical"))
(do
(remove-head-element "link[rel=\"canonical\"]")
(dom-remove-child (dom-parent el) el)
(dom-append-to-head el))
;; Everything else (ld+json, etc.) — just move
:else
(do
(dom-remove-child (dom-parent el) el)
(dom-append-to-head el)))))
els))))
;; --------------------------------------------------------------------------
;; Mount — render SX source into a DOM element
;; --------------------------------------------------------------------------
(define sx-mount :effects [mutation io]
(fn (target (source :as string) (extra-env :as dict))
;; Render SX source string into target element.
;; target: Element or CSS selector string
;; source: SX source string
;; extra-env: optional extra bindings dict
(let ((el (resolve-mount-target target)))
(when el
(let ((node (sx-render-with-env source extra-env)))
(dom-set-text-content el "")
(dom-append el node)
;; Hoist head elements from rendered content
(hoist-head-elements-full el)
;; Process sx- attributes, hydrate data-sx and islands
(process-elements el)
(sx-hydrate-elements el)
(sx-hydrate-islands el)
(flush-cssx-to-dom))))))
;; --------------------------------------------------------------------------
;; Resolve Suspense — replace streaming placeholder with resolved content
;; --------------------------------------------------------------------------
;;
;; Called by inline <script> tags that arrive during chunked transfer:
;; __sxResolve("content", "(~article :title \"Hello\")")
;;
;; Finds the suspense wrapper by data-suspense attribute, renders the
;; new SX content, and replaces the wrapper's children.
(define resolve-suspense :effects [mutation io]
(fn ((id :as string) (sx :as string))
;; Process any new <script type="text/sx"> tags that arrived via
;; streaming (e.g. extra component defs) before resolving.
(process-sx-scripts nil)
(let ((el (dom-query (str "[data-suspense=\"" id "\"]"))))
(if el
(do
;; parse returns a list of expressions — render each individually
;; (mirroring the public render() API).
(let ((exprs (parse sx))
(env (get-render-env nil)))
(dom-set-text-content el "")
(for-each (fn (expr)
(dom-append el (render-to-dom expr env nil)))
exprs)
(process-elements el)
(sx-hydrate-elements el)
(sx-hydrate-islands el)
(flush-cssx-to-dom)
(dom-dispatch el "sx:resolved" {:id id})))
(log-warn (str "resolveSuspense: no element for id=" id))))))
;; --------------------------------------------------------------------------
;; Hydrate — render all [data-sx] elements
;; --------------------------------------------------------------------------
(define sx-hydrate-elements :effects [mutation io]
(fn (root)
;; Find all [data-sx] elements within root and render them.
(let ((els (dom-query-all (or root (dom-body)) "[data-sx]")))
(for-each
(fn (el)
(when (not (is-processed? el "hydrated"))
(mark-processed! el "hydrated")
(sx-update-element el nil)))
els))))
;; --------------------------------------------------------------------------
;; Update — re-render a [data-sx] element with new env data
;; --------------------------------------------------------------------------
(define sx-update-element :effects [mutation io]
(fn (el new-env)
;; Re-render a [data-sx] element.
;; Reads source from data-sx attr, base env from data-sx-env attr.
(let ((target (resolve-mount-target el)))
(when target
(let ((source (dom-get-attr target "data-sx")))
(when source
(let ((base-env (parse-env-attr target))
(env (merge-envs base-env new-env)))
(let ((node (sx-render-with-env source env)))
(dom-set-text-content target "")
(dom-append target node)
;; Update stored env if new-env provided
(when new-env
(store-env-attr target base-env new-env))))))))))
;; --------------------------------------------------------------------------
;; Render component — build synthetic call from kwargs dict
;; --------------------------------------------------------------------------
(define sx-render-component :effects [mutation io]
(fn ((name :as string) (kwargs :as dict) (extra-env :as dict))
;; Render a named component with keyword args.
;; name: component name (with or without ~ prefix)
;; kwargs: dict of param-name → value
;; extra-env: optional extra env bindings
(let ((full-name (if (starts-with? name "~") name (str "~" name))))
(let ((env (get-render-env extra-env))
(comp (env-get env full-name)))
(if (not (component? comp))
(error (str "Unknown component: " full-name))
;; Build synthetic call expression
(let ((call-expr (list (make-symbol full-name))))
(for-each
(fn ((k :as string))
(append! call-expr (make-keyword (to-kebab k)))
(append! call-expr (dict-get kwargs k)))
(keys kwargs))
(render-to-dom call-expr env nil)))))))
;; --------------------------------------------------------------------------
;; Script processing — <script type="text/sx">
;; --------------------------------------------------------------------------
(define process-sx-scripts :effects [mutation io]
(fn (root)
;; Process all <script type="text/sx"> tags.
;; - data-components + data-hash → localStorage cache
;; - data-mount="<selector>" → render into target
;; - Default: load as components
(let ((scripts (query-sx-scripts root)))
(for-each
(fn (s)
(when (not (is-processed? s "script"))
(mark-processed! s "script")
(let ((text (dom-text-content s)))
(cond
;; Component definitions
(dom-has-attr? s "data-components")
(process-component-script s text)
;; Empty script — skip
(or (nil? text) (empty? (trim text)))
nil
;; Init scripts — evaluate SX for side effects (event listeners etc.)
(dom-has-attr? s "data-init")
(let ((exprs (sx-parse text)))
(for-each
(fn (expr) (eval-expr expr (env-extend (dict))))
exprs))
;; Mount directive
(dom-has-attr? s "data-mount")
(let ((mount-sel (dom-get-attr s "data-mount"))
(target (dom-query mount-sel)))
(when target
(sx-mount target text nil)))
;; Default: load as components
:else
(sx-load-components text)))))
scripts))))
;; --------------------------------------------------------------------------
;; Component script with caching
;; --------------------------------------------------------------------------
(define process-component-script :effects [mutation io]
(fn (script (text :as string))
;; Handle <script type="text/sx" data-components data-hash="...">
(let ((hash (dom-get-attr script "data-hash")))
(if (nil? hash)
;; Legacy: no hash — just load inline
(when (and text (not (empty? (trim text))))
(sx-load-components text))
;; Hash-based caching
(let ((has-inline (and text (not (empty? (trim text))))))
(let ((cached-hash (local-storage-get "sx-components-hash")))
(if (= cached-hash hash)
;; Cache hit
(if has-inline
;; Server sent full source (cookie stale) — update cache
(do
(local-storage-set "sx-components-hash" hash)
(local-storage-set "sx-components-src" text)
(sx-load-components text)
(log-info "components: downloaded (cookie stale)"))
;; Server omitted source — load from cache
(let ((cached (local-storage-get "sx-components-src")))
(if cached
(do
(sx-load-components cached)
(log-info (str "components: cached (" hash ")")))
;; Cache entry missing — clear cookie and reload
(do
(clear-sx-comp-cookie)
(browser-reload)))))
;; Cache miss — hash mismatch
(if has-inline
;; Server sent full source — cache it
(do
(local-storage-set "sx-components-hash" hash)
(local-storage-set "sx-components-src" text)
(sx-load-components text)
(log-info (str "components: downloaded (" hash ")")))
;; Server omitted but cache stale — clear and reload
(do
(local-storage-remove "sx-components-hash")
(local-storage-remove "sx-components-src")
(clear-sx-comp-cookie)
(browser-reload)))))
(set-sx-comp-cookie hash))))))
;; --------------------------------------------------------------------------
;; Page registry for client-side routing
;; --------------------------------------------------------------------------
(define _page-routes (list))
(define process-page-scripts :effects [mutation io]
(fn ()
;; Process <script type="text/sx-pages"> tags.
;; Parses SX page registry and builds route entries with parsed patterns.
(let ((scripts (query-page-scripts)))
(log-info (str "pages: found " (len scripts) " script tags"))
(for-each
(fn (s)
(when (not (is-processed? s "pages"))
(mark-processed! s "pages")
(let ((text (dom-text-content s)))
(log-info (str "pages: script text length=" (if text (len text) 0)))
(if (and text (not (empty? (trim text))))
(let ((pages (parse text)))
(log-info (str "pages: parsed " (len pages) " entries"))
(for-each
(fn ((page :as dict))
(append! _page-routes
(merge page
{"parsed" (parse-route-pattern (get page "path"))})))
pages))
(log-warn "pages: script tag is empty")))))
scripts)
(log-info (str "pages: " (len _page-routes) " routes loaded")))))
;; --------------------------------------------------------------------------
;; Island hydration — activate reactive islands from SSR output
;; --------------------------------------------------------------------------
;;
;; The server renders islands as:
;; <div data-sx-island="counter" data-sx-state='{"initial": 0}'>
;; ...static HTML...
;; </div>
;;
;; Hydration:
;; 1. Find all [data-sx-island] elements
;; 2. Look up the island component by name
;; 3. Parse data-sx-state into kwargs
;; 4. Re-render the island body in a reactive context
;; 5. Morph existing DOM to preserve structure, focus, scroll
;; 6. Store disposers on the element for cleanup
(define sx-hydrate-islands :effects [mutation io]
(fn (root)
(let ((els (dom-query-all (or root (dom-body)) "[data-sx-island]")))
(for-each
(fn (el)
(when (not (is-processed? el "island-hydrated"))
(mark-processed! el "island-hydrated")
(hydrate-island el)))
els))))
(define hydrate-island :effects [mutation io]
(fn (el)
(let ((name (dom-get-attr el "data-sx-island"))
(state-sx (or (dom-get-attr el "data-sx-state") "{}")))
(let ((comp-name (str "~" name))
(env (get-render-env nil)))
(let ((comp (env-get env comp-name)))
(if (not (or (component? comp) (island? comp)))
(log-warn (str "hydrate-island: unknown island " comp-name))
;; Parse state and build keyword args — SX format, not JSON
(let ((kwargs (or (first (sx-parse state-sx)) {}))
(disposers (list))
(local (env-merge (component-closure comp) env)))
;; Bind params from kwargs
(for-each
(fn ((p :as string))
(env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
(component-params comp))
;; Render the island body in a reactive scope
(let ((body-dom
(with-island-scope
(fn (disposable) (append! disposers disposable))
(fn () (render-to-dom (component-body comp) local nil)))))
;; Clear existing content and append reactive DOM directly.
;; Unlike morph-children, this preserves addEventListener-based
;; event handlers on the freshly rendered nodes.
(dom-set-text-content el "")
(dom-append el body-dom)
;; Store disposers for cleanup
(dom-set-data el "sx-disposers" disposers)
;; Process any sx- attributes on new content
(process-elements el)
(log-info (str "hydrated island: " comp-name
" (" (len disposers) " disposers)"))))))))))
;; --------------------------------------------------------------------------
;; Island disposal — clean up when island removed from DOM
;; --------------------------------------------------------------------------
(define dispose-island :effects [mutation io]
(fn (el)
(let ((disposers (dom-get-data el "sx-disposers")))
(when disposers
(for-each
(fn ((d :as lambda))
(when (callable? d) (d)))
disposers)
(dom-set-data el "sx-disposers" nil)))))
(define dispose-islands-in :effects [mutation io]
(fn (root)
;; Dispose islands within root, but SKIP hydrated islands —
;; they may be preserved across morphs. Only dispose islands
;; that are not currently hydrated (e.g. freshly parsed content
;; being discarded) or that have been explicitly detached.
(when root
(let ((islands (dom-query-all root "[data-sx-island]")))
(when (and islands (not (empty? islands)))
(let ((to-dispose (filter
(fn (el) (not (is-processed? el "island-hydrated")))
islands)))
(when (not (empty? to-dispose))
(log-info (str "disposing " (len to-dispose) " island(s)"))
(for-each dispose-island to-dispose))))))))
;; --------------------------------------------------------------------------
;; CSSX live flush — inject collected CSS rules into the DOM
;; --------------------------------------------------------------------------
;;
;; ~cssx/tw collects CSS rules via collect!("cssx" ...) during rendering.
;; On the server, ~cssx/flush emits a batch <style> tag. On the client,
;; islands render independently and no batch flush runs. This function
;; injects any unflushed rules into a persistent <style> element in <head>.
;; Called after hydration (boot + post-swap) to cover all render paths.
(define flush-cssx-to-dom :effects [mutation io]
(fn ()
(let ((rules (collected "cssx")))
(when (not (empty? rules))
(let ((style (or (dom-query "#sx-cssx-live")
(let ((s (dom-create-element "style" nil)))
(dom-set-attr s "id" "sx-cssx-live")
(dom-set-attr s "data-cssx" "")
(dom-append-to-head s)
s))))
(dom-set-prop style "textContent"
(str (or (dom-get-prop style "textContent") "")
(join "" rules))))
(clear-collected! "cssx")))))
;; --------------------------------------------------------------------------
;; Full boot sequence
;; --------------------------------------------------------------------------
(define boot-init :effects [mutation io]
(fn ()
;; Full browser initialization:
;; 1. CSS tracking
;; 2. Style dictionary
;; 3. Process scripts (components + mounts)
;; 4. Process page registry (client-side routing)
;; 5. Hydrate [data-sx] elements
;; 6. Hydrate [data-sx-island] elements (reactive islands)
;; 7. Process engine elements
(do
(log-info (str "sx-browser " SX_VERSION))
(init-css-tracking)
(process-page-scripts)
(process-sx-scripts nil)
(sx-hydrate-elements nil)
(sx-hydrate-islands nil)
(flush-cssx-to-dom)
(process-elements nil))))
;; --------------------------------------------------------------------------
;; Platform interface — Boot
;; --------------------------------------------------------------------------
;;
;; From orchestration.sx:
;; process-elements, init-css-tracking
;;
;; === DOM / Render ===
;; (resolve-mount-target target) → Element (string → querySelector, else identity)
;; (sx-render-with-env source extra-env) → DOM node (parse + render with componentEnv + extra)
;; (get-render-env extra-env) → merged component env + extra
;; (merge-envs base new) → merged env dict
;; (render-to-dom expr env ns) → DOM node
;; (sx-load-components text) → void (parse + eval into componentEnv)
;;
;; === DOM queries ===
;; (dom-query sel) → Element or nil
;; (dom-query-all root sel) → list of Elements
;; (dom-body) → document.body
;; (dom-get-attr el name) → string or nil
;; (dom-has-attr? el name) → boolean
;; (dom-text-content el) → string
;; (dom-set-text-content el s) → void
;; (dom-append el child) → void
;; (dom-remove-child parent el) → void
;; (dom-parent el) → Element
;; (dom-append-to-head el) → void
;; (dom-tag-name el) → string
;;
;; === Head hoisting ===
;; (set-document-title s) → void (document.title = s)
;; (remove-head-element sel) → void (remove matching element from <head>)
;;
;; === Script queries ===
;; (query-sx-scripts root) → list of <script type="text/sx"> elements
;; (query-page-scripts) → list of <script type="text/sx-pages"> elements
;;
;; === localStorage ===
;; (local-storage-get key) → string or nil
;; (local-storage-set key val) → void
;; (local-storage-remove key) → void
;;
;; === Cookies ===
;; (set-sx-comp-cookie hash) → void
;; (clear-sx-comp-cookie) → void
;;
;; === Env ===
;; (parse-env-attr el) → dict (parse data-sx-env JSON attr)
;; (store-env-attr el base new) → void (merge and store back as JSON)
;; (to-kebab s) → string (underscore → kebab-case)
;;
;; === Logging ===
;; (log-info msg) → void (console.log with prefix)
;; (log-parse-error label text err) → void (diagnostic parse error)
;;
;; === Parsing (island state) ===
;; (sx-parse str) → list of AST expressions (from parser.sx)
;;
;; === Processing markers ===
;; (mark-processed! el key) → void
;; (is-processed? el key) → boolean
;;
;; === Morph ===
;; (morph-children target source) → void (morph target's children to match source)
;;
;; === Island support (from adapter-dom.sx / signals.sx) ===
;; (island? x) → boolean
;; (component-closure comp) → env
;; (component-params comp) → list of param names
;; (component-body comp) → AST
;; (component-name comp) → string
;; (component-has-children? comp) → boolean
;; (with-island-scope scope-fn body-fn) → result (track disposables)
;; (render-to-dom expr env ns) → DOM node
;; (dom-get-data el key) → any (from el._sxData)
;; (dom-set-data el key val) → void
;; --------------------------------------------------------------------------