giles
89543e0152
The set!-based approach (nested when + mutate + re-check) didn't work because CEK evaluates the outer when condition once. Replace with a single (when (and should-fire (not modifier-click?)) ...) guard. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
1422 lines
61 KiB
Plaintext
1422 lines
61 KiB
Plaintext
;; ==========================================================================
|
|
;; orchestration.sx — Engine orchestration (browser wiring)
|
|
;;
|
|
;; Binds the pure engine logic to actual browser events, fetch, DOM
|
|
;; processing, and lifecycle management. This is the runtime that makes
|
|
;; the engine go.
|
|
;;
|
|
;; Dependency is one-way: orchestration → engine, never reverse.
|
|
;;
|
|
;; Depends on:
|
|
;; engine.sx — parse-trigger-spec, get-verb-info, build-request-headers,
|
|
;; process-response-headers, parse-swap-spec, parse-retry-spec,
|
|
;; next-retry-ms, resolve-target, apply-optimistic,
|
|
;; revert-optimistic, find-oob-swaps, swap-dom-nodes,
|
|
;; swap-html-string, morph-children, handle-history,
|
|
;; preload-cache-get, preload-cache-set, classify-trigger,
|
|
;; should-boost-link?, should-boost-form?, parse-sse-swap,
|
|
;; default-trigger, filter-params, PRELOAD_TTL
|
|
;; adapter-dom.sx — render-to-dom
|
|
;; render.sx — shared registries
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Engine state
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define _preload-cache (dict))
|
|
(define _css-hash "")
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Event dispatch helpers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define dispatch-trigger-events :effects [mutation io]
|
|
(fn (el (header-val :as string))
|
|
;; Dispatch events from SX-Trigger / SX-Trigger-After-Swap headers.
|
|
;; Value can be JSON object (name → detail) or comma-separated names.
|
|
(when header-val
|
|
(let ((parsed (try-parse-json header-val)))
|
|
(if parsed
|
|
;; JSON object: keys are event names, values are detail
|
|
(for-each
|
|
(fn ((key :as string))
|
|
(dom-dispatch el key (get parsed key)))
|
|
(keys parsed))
|
|
;; Comma-separated event names
|
|
(for-each
|
|
(fn ((name :as string))
|
|
(let ((trimmed (trim name)))
|
|
(when (not (empty? trimmed))
|
|
(dom-dispatch el trimmed (dict)))))
|
|
(split header-val ",")))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; CSS tracking
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define init-css-tracking :effects [mutation io]
|
|
(fn ()
|
|
;; Read initial CSS hash from meta tag
|
|
(let ((meta (dom-query "meta[name=\"sx-css-classes\"]")))
|
|
(when meta
|
|
(let ((content (dom-get-attr meta "content")))
|
|
(when content
|
|
(set! _css-hash content)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Request execution
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define execute-request :effects [mutation io]
|
|
(fn (el (verbInfo :as dict) (extraParams :as dict))
|
|
;; Gate checks then delegate to do-fetch.
|
|
;; verbInfo: dict with "method" and "url" (or nil to read from element).
|
|
;; Re-read from element in case attributes were morphed since binding.
|
|
;; Returns a promise.
|
|
(let ((info (or (get-verb-info el) verbInfo)))
|
|
(if (nil? info)
|
|
(promise-resolve nil)
|
|
(let ((verb (get info "method"))
|
|
(url (get info "url")))
|
|
;; Media query gate
|
|
(if (let ((media (dom-get-attr el "sx-media")))
|
|
(and media (not (browser-media-matches? media))))
|
|
(promise-resolve nil)
|
|
;; Confirm gate
|
|
(if (let ((confirm-msg (dom-get-attr el "sx-confirm")))
|
|
(and confirm-msg (not (browser-confirm confirm-msg))))
|
|
(promise-resolve nil)
|
|
;; Prompt
|
|
(let ((prompt-msg (dom-get-attr el "sx-prompt"))
|
|
(prompt-val (if prompt-msg (browser-prompt prompt-msg) nil)))
|
|
(if (and prompt-msg (nil? prompt-val))
|
|
(promise-resolve nil)
|
|
;; Validation gate
|
|
(if (not (validate-for-request el))
|
|
(promise-resolve nil)
|
|
(do-fetch el verb verb url
|
|
(if prompt-val
|
|
(assoc (or extraParams (dict)) "SX-Prompt" prompt-val)
|
|
extraParams))))))))))))
|
|
|
|
|
|
(define do-fetch :effects [mutation io]
|
|
(fn (el (verb :as string) (method :as string) (url :as string) (extraParams :as dict))
|
|
;; Execute the actual fetch. Manages abort, headers, body, loading state.
|
|
(let ((sync (dom-get-attr el "sx-sync")))
|
|
;; Abort previous if sync mode (per-element)
|
|
(when (= sync "replace")
|
|
(abort-previous el))
|
|
|
|
;; Abort any in-flight request targeting the same swap target,
|
|
;; but only when trigger and target are different elements.
|
|
;; This ensures rapid navigation (click A then B) cancels A's fetch,
|
|
;; while polling (element targets itself) doesn't abort its own requests.
|
|
(let ((target-el (resolve-target el)))
|
|
(when (and target-el (not (identical? el target-el)))
|
|
(abort-previous-target target-el)))
|
|
|
|
(let ((ctrl (new-abort-controller)))
|
|
(track-controller el ctrl)
|
|
;; Also track against the swap target for cross-element cancellation
|
|
(let ((target-el (resolve-target el)))
|
|
(when target-el
|
|
(track-controller-target target-el ctrl)))
|
|
|
|
;; Build request
|
|
(let ((body-info (build-request-body el method url))
|
|
(final-url (get body-info "url"))
|
|
(body (get body-info "body"))
|
|
(ct (get body-info "content-type"))
|
|
(headers (build-request-headers el
|
|
(loaded-component-names) _css-hash))
|
|
(csrf (csrf-token)))
|
|
|
|
;; Merge extra params as headers
|
|
(when extraParams
|
|
(for-each
|
|
(fn ((k :as string)) (dict-set! headers k (get extraParams k)))
|
|
(keys extraParams)))
|
|
|
|
;; Content-Type
|
|
(when ct
|
|
(dict-set! headers "Content-Type" ct))
|
|
|
|
;; CSRF
|
|
(when csrf
|
|
(dict-set! headers "X-CSRFToken" csrf))
|
|
|
|
;; Preload cache check
|
|
(let ((cached (preload-cache-get _preload-cache final-url))
|
|
(optimistic-state (apply-optimistic el))
|
|
(indicator (show-indicator el))
|
|
(disabled-elts (disable-elements el)))
|
|
|
|
;; Loading indicators
|
|
(dom-add-class el "sx-request")
|
|
(dom-set-attr el "aria-busy" "true")
|
|
(dom-dispatch el "sx:beforeRequest" (dict "url" final-url "method" method))
|
|
|
|
;; Fetch
|
|
(fetch-request
|
|
(dict "url" final-url
|
|
"method" method
|
|
"headers" headers
|
|
"body" body
|
|
"signal" (controller-signal ctrl)
|
|
"cross-origin" (cross-origin? final-url)
|
|
"preloaded" cached)
|
|
;; Success callback
|
|
(fn ((resp-ok :as boolean) (status :as number) get-header (text :as string))
|
|
(do
|
|
(clear-loading-state el indicator disabled-elts)
|
|
(revert-optimistic optimistic-state)
|
|
(if (not resp-ok)
|
|
(do
|
|
(dom-dispatch el "sx:responseError"
|
|
(dict "status" status "text" text))
|
|
;; If the error response has SX content, swap it in
|
|
;; (e.g. 404 pages) instead of just retrying
|
|
(if (and text (> (len text) 0))
|
|
(handle-fetch-success el final-url verb extraParams
|
|
get-header text)
|
|
(handle-retry el verb method final-url extraParams)))
|
|
(do
|
|
(dom-dispatch el "sx:afterRequest"
|
|
(dict "status" status))
|
|
(handle-fetch-success el final-url verb extraParams
|
|
get-header text)))))
|
|
;; Error callback
|
|
(fn (err)
|
|
(do
|
|
(clear-loading-state el indicator disabled-elts)
|
|
(revert-optimistic optimistic-state)
|
|
(when (not (abort-error? err))
|
|
(log-warn (str "sx:fetch error " method " " final-url " — " err))
|
|
(dom-dispatch el "sx:requestError"
|
|
(dict "error" err))))))))))))
|
|
|
|
|
|
(define handle-fetch-success :effects [mutation io]
|
|
(fn (el (url :as string) (verb :as string) (extraParams :as dict) get-header (text :as string))
|
|
;; Route a successful response through the appropriate handler.
|
|
(let ((resp-headers (process-response-headers get-header)))
|
|
;; CSS hash update
|
|
(let ((new-hash (get resp-headers "css-hash")))
|
|
(when new-hash (set! _css-hash new-hash)))
|
|
|
|
;; Triggers (before swap)
|
|
(dispatch-trigger-events el (get resp-headers "trigger"))
|
|
|
|
;; Cache directives — process before navigation so cache is
|
|
;; ready when the target page loads.
|
|
(process-cache-directives el resp-headers text)
|
|
|
|
(cond
|
|
;; Redirect
|
|
(get resp-headers "redirect")
|
|
(browser-navigate (get resp-headers "redirect"))
|
|
|
|
;; Refresh
|
|
(get resp-headers "refresh")
|
|
(browser-reload)
|
|
|
|
;; Location (SX-Location header)
|
|
(get resp-headers "location")
|
|
(fetch-location (get resp-headers "location"))
|
|
|
|
;; Normal response — route by content type
|
|
:else
|
|
(let ((target-el (if (get resp-headers "retarget")
|
|
(dom-query (get resp-headers "retarget"))
|
|
(resolve-target el)))
|
|
(swap-spec (parse-swap-spec
|
|
(or (get resp-headers "reswap")
|
|
(dom-get-attr el "sx-swap"))
|
|
(dom-has-class? (dom-body) "sx-transitions")))
|
|
(swap-style (get swap-spec "style"))
|
|
(use-transition (get swap-spec "transition"))
|
|
(ct (or (get resp-headers "content-type") "")))
|
|
|
|
;; Dispatch by content type
|
|
(if (contains? ct "text/sx")
|
|
(handle-sx-response el target-el text swap-style use-transition)
|
|
(handle-html-response el target-el text swap-style use-transition))
|
|
|
|
;; Post-swap triggers
|
|
(dispatch-trigger-events el (get resp-headers "trigger-swap"))
|
|
|
|
;; History
|
|
(handle-history el url resp-headers)
|
|
|
|
;; Settle phase (after small delay): triggers + sx-on-settle hooks
|
|
(set-timeout
|
|
(fn ()
|
|
;; Server-driven settle triggers
|
|
(when (get resp-headers "trigger-settle")
|
|
(dispatch-trigger-events el
|
|
(get resp-headers "trigger-settle")))
|
|
;; sx-on-settle: evaluate SX expression after swap settles
|
|
(process-settle-hooks el))
|
|
20)
|
|
|
|
;; Lifecycle event
|
|
(dom-dispatch el "sx:afterSwap"
|
|
(dict "target" target-el "swap" swap-style)))))))
|
|
|
|
|
|
(define handle-sx-response :effects [mutation io]
|
|
(fn (el target (text :as string) (swap-style :as string) (use-transition :as boolean))
|
|
;; Handle SX-format response: strip components, extract CSS, render, swap.
|
|
(let ((cleaned (strip-component-scripts text)))
|
|
(let ((final (extract-response-css cleaned)))
|
|
(let ((trimmed (trim final)))
|
|
(when (not (empty? trimmed))
|
|
(let ((rendered (sx-render trimmed))
|
|
(container (dom-create-element "div" nil)))
|
|
(dom-append container rendered)
|
|
;; Process OOB swaps
|
|
(process-oob-swaps container
|
|
(fn (t oob (s :as string))
|
|
(dispose-islands-in t)
|
|
(swap-dom-nodes t oob s)
|
|
(sx-hydrate t)
|
|
(process-elements t)))
|
|
;; Select if specified
|
|
(let ((select-sel (dom-get-attr el "sx-select"))
|
|
(content (if select-sel
|
|
(select-from-container container select-sel)
|
|
(children-to-fragment container))))
|
|
;; Dispose non-hydrated islands before swap.
|
|
;; Hydrated islands are preserved — the morph algorithm
|
|
;; keeps their live signals and only morphs their lakes.
|
|
(dispose-islands-in target)
|
|
;; Swap
|
|
(with-transition use-transition
|
|
(fn ()
|
|
(swap-dom-nodes target content swap-style)
|
|
(post-swap target)))))))))))
|
|
|
|
|
|
(define handle-html-response :effects [mutation io]
|
|
(fn (el target (text :as string) (swap-style :as string) (use-transition :as boolean))
|
|
;; Handle HTML-format response: parse, OOB, select, swap.
|
|
(let ((doc (dom-parse-html-document text)))
|
|
(when doc
|
|
(let ((select-sel (dom-get-attr el "sx-select")))
|
|
;; Dispose old islands before swap
|
|
(dispose-islands-in target)
|
|
(if select-sel
|
|
;; Select from parsed document
|
|
(let ((html (select-html-from-doc doc select-sel)))
|
|
(with-transition use-transition
|
|
(fn ()
|
|
(swap-html-string target html swap-style)
|
|
(post-swap target))))
|
|
;; Full body content
|
|
(let ((container (dom-create-element "div" nil)))
|
|
(dom-set-inner-html container (dom-body-inner-html doc))
|
|
;; Process OOB swaps
|
|
(process-oob-swaps container
|
|
(fn (t oob (s :as string))
|
|
(dispose-islands-in t)
|
|
(swap-dom-nodes t oob s)
|
|
(post-swap t)))
|
|
;; Hoist head elements
|
|
(hoist-head-elements container)
|
|
;; Swap remaining content
|
|
(with-transition use-transition
|
|
(fn ()
|
|
(swap-dom-nodes target (children-to-fragment container) swap-style)
|
|
(post-swap target))))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Retry
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define handle-retry :effects [mutation io]
|
|
(fn (el (verb :as string) (method :as string) (url :as string) (extraParams :as dict))
|
|
;; Handle retry on failure if sx-retry is configured
|
|
(let ((retry-attr (dom-get-attr el "sx-retry"))
|
|
(spec (parse-retry-spec retry-attr)))
|
|
(when spec
|
|
(let ((current-ms (or (dom-get-attr el "data-sx-retry-ms")
|
|
(get spec "start-ms"))))
|
|
(let ((ms (parse-int current-ms (get spec "start-ms"))))
|
|
(dom-set-attr el "data-sx-retry-ms"
|
|
(str (next-retry-ms ms (get spec "cap-ms"))))
|
|
(set-timeout
|
|
(fn () (do-fetch el verb method url extraParams))
|
|
ms)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Trigger binding
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define bind-triggers :effects [mutation io]
|
|
(fn (el (verbInfo :as dict))
|
|
;; Bind triggers from sx-trigger attribute (or defaults)
|
|
(let ((triggers (or (parse-trigger-spec (dom-get-attr el "sx-trigger"))
|
|
(default-trigger (dom-tag-name el)))))
|
|
(for-each
|
|
(fn ((trigger :as dict))
|
|
(let ((kind (classify-trigger trigger))
|
|
(mods (get trigger "modifiers")))
|
|
(cond
|
|
(= kind "poll")
|
|
(set-interval
|
|
(fn () (execute-request el nil nil))
|
|
(get mods "interval"))
|
|
|
|
(= kind "intersect")
|
|
(observe-intersection el
|
|
(fn () (execute-request el nil nil))
|
|
false (get mods "delay"))
|
|
|
|
(= kind "load")
|
|
(set-timeout
|
|
(fn () (execute-request el nil nil))
|
|
(or (get mods "delay") 0))
|
|
|
|
(= kind "revealed")
|
|
(observe-intersection el
|
|
(fn () (execute-request el nil nil))
|
|
true (get mods "delay"))
|
|
|
|
(= kind "event")
|
|
(bind-event el (get trigger "event") mods verbInfo))))
|
|
triggers))))
|
|
|
|
|
|
(define bind-event :effects [mutation io]
|
|
(fn (el (event-name :as string) (mods :as dict) (verbInfo :as dict))
|
|
;; Bind a standard DOM event trigger.
|
|
;; Handles delay, once, changed, optimistic, preventDefault.
|
|
(let ((timer nil)
|
|
(last-val nil)
|
|
(listen-target (if (get mods "from")
|
|
(dom-query (get mods "from"))
|
|
el)))
|
|
(when listen-target
|
|
(dom-add-listener listen-target event-name
|
|
(fn (e)
|
|
(let ((should-fire true))
|
|
;; Changed modifier: skip if value unchanged
|
|
(when (get mods "changed")
|
|
(let ((val (element-value el)))
|
|
(if (= val last-val)
|
|
(set! should-fire false)
|
|
(set! last-val val))))
|
|
|
|
;; Let browser handle modifier-key clicks (ctrl-click → new tab)
|
|
(when (and should-fire
|
|
(not (and (= event-name "click") (event-modifier-key? e))))
|
|
;; Prevent default for submit/click on links
|
|
(when (or (= event-name "submit")
|
|
(and (= event-name "click")
|
|
(dom-has-attr? el "href")))
|
|
(prevent-default e))
|
|
|
|
;; Re-read verb info from element at click time (not closed-over)
|
|
(let ((live-info (or (get-verb-info el) verbInfo))
|
|
(is-get-link (and (= event-name "click")
|
|
(= (get live-info "method") "GET")
|
|
(dom-has-attr? el "href")
|
|
(not (get mods "delay"))))
|
|
(client-routed false))
|
|
(when is-get-link
|
|
(set! client-routed
|
|
(try-client-route
|
|
(url-pathname (get live-info "url"))
|
|
(dom-get-attr el "sx-target"))))
|
|
(if client-routed
|
|
(do
|
|
(browser-push-state (get live-info "url"))
|
|
(browser-scroll-to 0 0))
|
|
(do
|
|
(when is-get-link
|
|
(log-info (str "sx:route server fetch " (get live-info "url"))))
|
|
(if (get mods "delay")
|
|
(do
|
|
(clear-timeout timer)
|
|
(set! timer
|
|
(set-timeout
|
|
(fn () (execute-request el nil nil))
|
|
(get mods "delay"))))
|
|
(execute-request el nil nil))))))))
|
|
(if (get mods "once") (dict "once" true) nil))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Post-swap lifecycle
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define post-swap :effects [mutation io]
|
|
(fn (root)
|
|
;; Run lifecycle after swap: activate scripts, process SX, hydrate, process
|
|
(log-info (str "post-swap: root=" (if root (dom-tag-name root) "nil")))
|
|
(activate-scripts root)
|
|
(sx-process-scripts root)
|
|
(sx-hydrate root)
|
|
(sx-hydrate-islands root)
|
|
(run-post-render-hooks)
|
|
(process-elements root)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; sx-on-settle — post-swap SX evaluation
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; After a swap settles, evaluate the SX expression in the trigger element's
|
|
;; sx-on-settle attribute. The expression has access to all primitives
|
|
;; (including use-store, reset!, deref) so it can update reactive state
|
|
;; based on what the server returned.
|
|
;;
|
|
;; Example: (button :sx-get "/search" :sx-on-settle "(reset! (use-store \"count\") 0)")
|
|
|
|
(define process-settle-hooks :effects [mutation io]
|
|
(fn (el)
|
|
(let ((settle-expr (dom-get-attr el "sx-on-settle")))
|
|
(when (and settle-expr (not (empty? settle-expr)))
|
|
(let ((exprs (sx-parse settle-expr)))
|
|
(for-each
|
|
(fn (expr) (eval-expr expr (env-extend (dict))))
|
|
exprs))))))
|
|
|
|
|
|
(define activate-scripts :effects [mutation io]
|
|
(fn (root)
|
|
;; Re-activate scripts in swapped content.
|
|
;; Scripts inserted via innerHTML are inert — clone to make them execute.
|
|
(when root
|
|
(let ((scripts (dom-query-all root "script")))
|
|
(for-each
|
|
(fn (dead)
|
|
;; Skip already-processed or data-components scripts
|
|
(when (and (not (dom-has-attr? dead "data-components"))
|
|
(not (dom-has-attr? dead "data-sx-activated")))
|
|
(let ((live (create-script-clone dead)))
|
|
(dom-set-attr live "data-sx-activated" "true")
|
|
(dom-replace-child (dom-parent dead) live dead))))
|
|
scripts)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; OOB swap processing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define process-oob-swaps :effects [mutation io]
|
|
(fn (container (swap-fn :as lambda))
|
|
;; Find and process out-of-band swaps in container.
|
|
;; swap-fn is (fn (target oob-element swap-type) ...).
|
|
(let ((oobs (find-oob-swaps container)))
|
|
(for-each
|
|
(fn ((oob :as dict))
|
|
(let ((target-id (get oob "target-id"))
|
|
(target (dom-query-by-id target-id))
|
|
(oob-el (get oob "element"))
|
|
(swap-type (get oob "swap-type")))
|
|
;; Remove from source container
|
|
(when (dom-parent oob-el)
|
|
(dom-remove-child (dom-parent oob-el) oob-el))
|
|
;; Swap into target
|
|
(when target
|
|
(swap-fn target oob-el swap-type))))
|
|
oobs))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Head element hoisting
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define hoist-head-elements :effects [mutation io]
|
|
(fn (container)
|
|
;; Move style[data-sx-css] and link[rel=stylesheet] to <head>
|
|
;; so they take effect globally.
|
|
(for-each
|
|
(fn (style)
|
|
(when (dom-parent style)
|
|
(dom-remove-child (dom-parent style) style))
|
|
(dom-append-to-head style))
|
|
(dom-query-all container "style[data-sx-css]"))
|
|
(for-each
|
|
(fn (link)
|
|
(when (dom-parent link)
|
|
(dom-remove-child (dom-parent link) link))
|
|
(dom-append-to-head link))
|
|
(dom-query-all container "link[rel=\"stylesheet\"]"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Boost processing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define process-boosted :effects [mutation io]
|
|
(fn (root)
|
|
;; Find [sx-boost] containers and boost their descendants
|
|
(for-each
|
|
(fn (container)
|
|
(boost-descendants container))
|
|
(dom-query-all (or root (dom-body)) "[sx-boost]"))))
|
|
|
|
|
|
(define boost-descendants :effects [mutation io]
|
|
(fn (container)
|
|
;; Boost links and forms within a container.
|
|
;; The sx-boost attribute value is the default target selector
|
|
;; for boosted descendants (e.g. sx-boost="#main-panel").
|
|
(let ((boost-target (dom-get-attr container "sx-boost")))
|
|
(for-each
|
|
(fn (link)
|
|
(when (and (not (is-processed? link "boost"))
|
|
(should-boost-link? link))
|
|
(mark-processed! link "boost")
|
|
;; Inherit target from boost container if not specified
|
|
(when (and (not (dom-has-attr? link "sx-target"))
|
|
boost-target (not (= boost-target "true")))
|
|
(dom-set-attr link "sx-target" boost-target))
|
|
(when (not (dom-has-attr? link "sx-swap"))
|
|
(dom-set-attr link "sx-swap" "innerHTML"))
|
|
(when (not (dom-has-attr? link "sx-push-url"))
|
|
(dom-set-attr link "sx-push-url" "true"))
|
|
(bind-client-route-link link (dom-get-attr link "href"))))
|
|
(dom-query-all container "a[href]"))
|
|
(for-each
|
|
(fn (form)
|
|
(when (and (not (is-processed? form "boost"))
|
|
(should-boost-form? form))
|
|
(mark-processed! form "boost")
|
|
(let ((method (upper (or (dom-get-attr form "method") "GET")))
|
|
(action (or (dom-get-attr form "action")
|
|
(browser-location-href))))
|
|
(when (and (not (dom-has-attr? form "sx-target"))
|
|
boost-target (not (= boost-target "true")))
|
|
(dom-set-attr form "sx-target" boost-target))
|
|
(when (not (dom-has-attr? form "sx-swap"))
|
|
(dom-set-attr form "sx-swap" "innerHTML"))
|
|
(bind-boost-form form method action))))
|
|
(dom-query-all container "form")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Client-side routing — data cache
|
|
;; --------------------------------------------------------------------------
|
|
|
|
;; Cache for page data resolved via resolve-page-data.
|
|
;; Keyed by "page-name:param1=val1¶m2=val2", value is {data, ts}.
|
|
;; Default TTL: 30s. Prevents redundant fetches on back/forward navigation.
|
|
|
|
(define _page-data-cache (dict))
|
|
(define _page-data-cache-ttl 30000) ;; 30 seconds in ms
|
|
|
|
(define page-data-cache-key :effects []
|
|
(fn ((page-name :as string) (params :as dict))
|
|
;; Build a cache key from page name + params.
|
|
;; Params are from route matching so order is deterministic.
|
|
(let ((base page-name))
|
|
(if (or (nil? params) (empty? (keys params)))
|
|
base
|
|
(let ((parts (list)))
|
|
(for-each
|
|
(fn ((k :as string))
|
|
(append! parts (str k "=" (get params k))))
|
|
(keys params))
|
|
(str base ":" (join "&" parts)))))))
|
|
|
|
(define page-data-cache-get :effects [mutation io]
|
|
(fn ((cache-key :as string))
|
|
;; Return cached data if fresh, else nil.
|
|
(let ((entry (get _page-data-cache cache-key)))
|
|
(if (nil? entry)
|
|
nil
|
|
(if (> (- (now-ms) (get entry "ts")) _page-data-cache-ttl)
|
|
(do
|
|
(dict-set! _page-data-cache cache-key nil)
|
|
nil)
|
|
(get entry "data"))))))
|
|
|
|
(define page-data-cache-set :effects [mutation io]
|
|
(fn ((cache-key :as string) data)
|
|
;; Store data with current timestamp.
|
|
(dict-set! _page-data-cache cache-key
|
|
{"data" data "ts" (now-ms)})))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Client-side routing — cache management
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define invalidate-page-cache :effects [mutation io]
|
|
(fn ((page-name :as string))
|
|
;; Clear cached data for a page. Removes all cache entries whose key
|
|
;; matches page-name (exact) or starts with "page-name:" (with params).
|
|
;; Also notifies the service worker to clear its IndexedDB entries.
|
|
(for-each
|
|
(fn ((k :as string))
|
|
(when (or (= k page-name) (starts-with? k (str page-name ":")))
|
|
(dict-set! _page-data-cache k nil)))
|
|
(keys _page-data-cache))
|
|
(sw-post-message {"type" "invalidate" "page" page-name})
|
|
(log-info (str "sx:cache invalidate " page-name))))
|
|
|
|
(define invalidate-all-page-cache :effects [mutation io]
|
|
(fn ()
|
|
;; Clear all cached page data and notify service worker.
|
|
(set! _page-data-cache (dict))
|
|
(sw-post-message {"type" "invalidate" "page" "*"})
|
|
(log-info "sx:cache invalidate *")))
|
|
|
|
(define update-page-cache :effects [mutation io]
|
|
(fn ((page-name :as string) data)
|
|
;; Replace cached data for a page with server-provided data.
|
|
;; Uses a bare page-name key (no params) — the server knows the
|
|
;; canonical data shape for the page.
|
|
(let ((cache-key (page-data-cache-key page-name (dict))))
|
|
(page-data-cache-set cache-key data)
|
|
(log-info (str "sx:cache update " page-name)))))
|
|
|
|
(define process-cache-directives :effects [mutation io]
|
|
(fn (el (resp-headers :as dict) (response-text :as string))
|
|
;; Process cache invalidation and update directives from both
|
|
;; element attributes and response headers.
|
|
;;
|
|
;; Element attributes (set by component author):
|
|
;; sx-cache-invalidate="page-name" — clear page cache on success
|
|
;; sx-cache-invalidate="*" — clear all page caches
|
|
;;
|
|
;; Response headers (set by server):
|
|
;; SX-Cache-Invalidate: page-name — clear page cache
|
|
;; SX-Cache-Update: page-name — replace cache with response data
|
|
|
|
;; 1. Element-level invalidation
|
|
(let ((el-invalidate (dom-get-attr el "sx-cache-invalidate")))
|
|
(when el-invalidate
|
|
(if (= el-invalidate "*")
|
|
(invalidate-all-page-cache)
|
|
(invalidate-page-cache el-invalidate))))
|
|
|
|
;; 2. Response header invalidation
|
|
(let ((hdr-invalidate (get resp-headers "cache-invalidate")))
|
|
(when hdr-invalidate
|
|
(if (= hdr-invalidate "*")
|
|
(invalidate-all-page-cache)
|
|
(invalidate-page-cache hdr-invalidate))))
|
|
|
|
;; 3. Response header cache update (server pushes fresh data)
|
|
;; parse-sx-data is a platform-provided function that parses SX text
|
|
;; into a data value (returns nil on parse error).
|
|
(let ((hdr-update (get resp-headers "cache-update")))
|
|
(when hdr-update
|
|
(let ((data (parse-sx-data response-text)))
|
|
(when data
|
|
(update-page-cache hdr-update data)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Optimistic data updates (Phase 7c)
|
|
;; --------------------------------------------------------------------------
|
|
;; Client-side predicted mutations with rollback.
|
|
;; submit-mutation applies a predicted update immediately, sends the mutation
|
|
;; to the server, and either confirms or reverts based on the response.
|
|
|
|
(define _optimistic-snapshots (dict))
|
|
|
|
(define optimistic-cache-update :effects [mutation]
|
|
(fn ((cache-key :as string) (mutator :as lambda))
|
|
;; Apply predicted mutation to cached data. Saves snapshot for rollback.
|
|
;; Returns predicted data or nil if no cached data exists.
|
|
(let ((cached (page-data-cache-get cache-key)))
|
|
(when cached
|
|
(let ((predicted (mutator cached)))
|
|
;; Save original for revert
|
|
(dict-set! _optimistic-snapshots cache-key cached)
|
|
;; Update cache with prediction
|
|
(page-data-cache-set cache-key predicted)
|
|
predicted)))))
|
|
|
|
(define optimistic-cache-revert :effects [mutation]
|
|
(fn ((cache-key :as string))
|
|
;; Revert to pre-mutation snapshot. Returns restored data or nil.
|
|
(let ((snapshot (get _optimistic-snapshots cache-key)))
|
|
(when snapshot
|
|
(page-data-cache-set cache-key snapshot)
|
|
(dict-delete! _optimistic-snapshots cache-key)
|
|
snapshot))))
|
|
|
|
(define optimistic-cache-confirm :effects [mutation]
|
|
(fn ((cache-key :as string))
|
|
;; Server accepted — discard the rollback snapshot.
|
|
(dict-delete! _optimistic-snapshots cache-key)))
|
|
|
|
(define submit-mutation :effects [mutation io]
|
|
(fn ((page-name :as string) (params :as dict) (action-name :as string) payload (mutator-fn :as lambda) (on-complete :as lambda))
|
|
;; Optimistic mutation: predict locally, send to server, confirm or revert.
|
|
;; on-complete is called with "confirmed" or "reverted" status.
|
|
(let ((cache-key (page-data-cache-key page-name params))
|
|
(predicted (optimistic-cache-update cache-key mutator-fn)))
|
|
;; Re-render with predicted data immediately
|
|
(when predicted
|
|
(try-rerender-page page-name params predicted))
|
|
;; Send to server
|
|
(execute-action action-name payload
|
|
(fn (result)
|
|
;; Success: update cache with server truth, confirm
|
|
(when result
|
|
(page-data-cache-set cache-key result))
|
|
(optimistic-cache-confirm cache-key)
|
|
(when result
|
|
(try-rerender-page page-name params result))
|
|
(log-info (str "sx:optimistic confirmed " page-name))
|
|
(when on-complete (on-complete "confirmed")))
|
|
(fn ((error :as string))
|
|
;; Failure: revert to snapshot
|
|
(let ((reverted (optimistic-cache-revert cache-key)))
|
|
(when reverted
|
|
(try-rerender-page page-name params reverted))
|
|
(log-warn (str "sx:optimistic reverted " page-name ": " error))
|
|
(when on-complete (on-complete "reverted"))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Offline data layer (Phase 7d)
|
|
;; --------------------------------------------------------------------------
|
|
;; Connectivity tracking + offline mutation queue.
|
|
;; When offline, mutations are queued locally. On reconnect, queued mutations
|
|
;; are replayed in order via submit-mutation.
|
|
|
|
(define _is-online true)
|
|
(define _offline-queue (list))
|
|
|
|
(define offline-is-online? :effects [io]
|
|
(fn () _is-online))
|
|
|
|
(define offline-set-online! :effects [mutation]
|
|
(fn ((val :as boolean))
|
|
(set! _is-online val)))
|
|
|
|
(define offline-queue-mutation :effects [mutation io]
|
|
(fn ((action-name :as string) payload (page-name :as string) (params :as dict) (mutator-fn :as lambda))
|
|
;; Queue a mutation for later sync. Apply optimistic update locally.
|
|
(let ((cache-key (page-data-cache-key page-name params))
|
|
(entry (dict
|
|
"action" action-name
|
|
"payload" payload
|
|
"page" page-name
|
|
"params" params
|
|
"timestamp" (now-ms)
|
|
"status" "pending")))
|
|
(append! _offline-queue entry)
|
|
;; Apply optimistic locally (reuses Phase 7c)
|
|
(let ((predicted (optimistic-cache-update cache-key mutator-fn)))
|
|
(when predicted
|
|
(try-rerender-page page-name params predicted)))
|
|
(log-info (str "sx:offline queued " action-name " (" (len _offline-queue) " pending)"))
|
|
entry)))
|
|
|
|
(define offline-sync :effects [mutation io]
|
|
(fn ()
|
|
;; Replay all pending mutations. Called on reconnect.
|
|
(let ((pending (filter (fn ((e :as dict)) (= (get e "status") "pending")) _offline-queue)))
|
|
(when (not (empty? pending))
|
|
(log-info (str "sx:offline syncing " (len pending) " mutations"))
|
|
(for-each
|
|
(fn ((entry :as dict))
|
|
(execute-action (get entry "action") (get entry "payload")
|
|
(fn (result)
|
|
(dict-set! entry "status" "synced")
|
|
(log-info (str "sx:offline synced " (get entry "action"))))
|
|
(fn ((error :as string))
|
|
(dict-set! entry "status" "failed")
|
|
(log-warn (str "sx:offline sync failed " (get entry "action") ": " error)))))
|
|
pending)))))
|
|
|
|
(define offline-pending-count :effects [io]
|
|
(fn ()
|
|
(len (filter (fn ((e :as dict)) (= (get e "status") "pending")) _offline-queue))))
|
|
|
|
(define offline-aware-mutation :effects [mutation io]
|
|
(fn ((page-name :as string) (params :as dict) (action-name :as string) payload (mutator-fn :as lambda) (on-complete :as lambda))
|
|
;; Top-level mutation function. Routes to submit-mutation when online,
|
|
;; offline-queue-mutation when offline.
|
|
(if _is-online
|
|
(submit-mutation page-name params action-name payload mutator-fn on-complete)
|
|
(do
|
|
(offline-queue-mutation action-name payload page-name params mutator-fn)
|
|
(when on-complete (on-complete "queued"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Client-side routing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define current-page-layout :effects [io]
|
|
(fn ()
|
|
;; Find the layout name of the currently displayed page by matching
|
|
;; the browser URL against the page route table.
|
|
(let ((pathname (url-pathname (browser-location-href)))
|
|
(match (find-matching-route pathname _page-routes)))
|
|
(if (nil? match) ""
|
|
(or (get match "layout") "")))))
|
|
|
|
|
|
(define swap-rendered-content :effects [mutation io]
|
|
(fn (target rendered (pathname :as string))
|
|
;; Swap rendered DOM content into target and run post-processing.
|
|
;; Shared by pure and data page client routes.
|
|
(do
|
|
(dispose-islands-in target)
|
|
(dom-set-text-content target "")
|
|
(dom-append target rendered)
|
|
(hoist-head-elements-full target)
|
|
(process-elements target)
|
|
(sx-hydrate-elements target)
|
|
(sx-hydrate-islands target)
|
|
(run-post-render-hooks)
|
|
(dom-dispatch target "sx:clientRoute"
|
|
(dict "pathname" pathname))
|
|
(log-info (str "sx:route client " pathname)))))
|
|
|
|
|
|
(define resolve-route-target :effects [io]
|
|
(fn ((target-sel :as string))
|
|
;; Resolve a target selector to a DOM element, or nil.
|
|
(if (and target-sel (not (= target-sel "true")))
|
|
(dom-query target-sel)
|
|
nil)))
|
|
|
|
|
|
(define deps-satisfied? :effects [io]
|
|
(fn ((match :as dict))
|
|
;; Check if all component deps for a page are loaded client-side.
|
|
(let ((deps (get match "deps"))
|
|
(loaded (loaded-component-names)))
|
|
(if (or (nil? deps) (empty? deps))
|
|
true
|
|
(every? (fn ((dep :as string)) (contains? loaded dep)) deps)))))
|
|
|
|
|
|
(define try-client-route :effects [mutation io]
|
|
(fn ((pathname :as string) (target-sel :as string))
|
|
;; Try to render a page client-side. Returns true if successful, false otherwise.
|
|
;; target-sel is the CSS selector for the swap target (from sx-boost value).
|
|
;; For pure pages: renders immediately. For :data pages: fetches data then renders.
|
|
;; Falls through to server when layout changes (needs OOB header update).
|
|
(let ((match (find-matching-route pathname _page-routes)))
|
|
(if (nil? match)
|
|
(do (log-info (str "sx:route no match (" (len _page-routes) " routes) " pathname)) false)
|
|
(let ((target-layout (or (get match "layout") ""))
|
|
(cur-layout (current-page-layout)))
|
|
(if (not (= target-layout cur-layout))
|
|
(do (log-info (str "sx:route server (layout: " cur-layout " -> " target-layout ") " pathname)) false)
|
|
(let ((content-src (get match "content"))
|
|
(closure (or (get match "closure") {}))
|
|
(params (get match "params"))
|
|
(page-name (get match "name")))
|
|
(if (or (nil? content-src) (empty? content-src))
|
|
(do (log-warn (str "sx:route no content for " pathname)) false)
|
|
(let ((target (resolve-route-target target-sel)))
|
|
(if (nil? target)
|
|
(do (log-warn (str "sx:route target not found: " target-sel)) false)
|
|
(if (not (deps-satisfied? match))
|
|
(do (log-info (str "sx:route deps miss for " page-name)) false)
|
|
(let ((io-deps (get match "io-deps"))
|
|
(has-io (and io-deps (not (empty? io-deps))))
|
|
(render-plan (get match "render-plan")))
|
|
;; Log render plan for boundary visibility
|
|
(when render-plan
|
|
(let ((srv (or (get render-plan "server") (list)))
|
|
(cli (or (get render-plan "client") (list))))
|
|
(log-info (str "sx:route plan " page-name
|
|
" — " (len srv) " server, " (len cli) " client"))))
|
|
;; Ensure IO deps are registered as proxied primitives
|
|
(when has-io (register-io-deps io-deps))
|
|
(if (get match "stream")
|
|
;; Streaming page: fetch with streaming body reader.
|
|
;; First chunk = OOB SX swap (shell with skeletons),
|
|
;; subsequent chunks = resolve scripts filling slots.
|
|
(do (log-info (str "sx:route streaming " pathname))
|
|
(fetch-streaming target pathname
|
|
(build-request-headers target
|
|
(loaded-component-names) _css-hash))
|
|
true)
|
|
(if (get match "has-data")
|
|
;; Data page: check cache, else resolve asynchronously
|
|
(let ((cache-key (page-data-cache-key page-name params))
|
|
(cached (page-data-cache-get cache-key)))
|
|
(if cached
|
|
;; Cache hit
|
|
(let ((env (merge closure params cached)))
|
|
(if has-io
|
|
;; Async render (data+IO)
|
|
(do
|
|
(log-info (str "sx:route client+cache+async " pathname))
|
|
(try-async-eval-content content-src env
|
|
(fn (rendered)
|
|
(if (nil? rendered)
|
|
(do (log-warn (str "sx:route cache+async eval failed for " pathname " — server fallback"))
|
|
(fetch-and-restore target pathname
|
|
(build-request-headers target (loaded-component-names) _css-hash) 0))
|
|
(swap-rendered-content target rendered pathname))))
|
|
true)
|
|
;; Sync render (data only)
|
|
(let ((rendered (try-eval-content content-src env)))
|
|
(if (nil? rendered)
|
|
(do (log-warn (str "sx:route cached eval failed for " pathname)) false)
|
|
(do
|
|
(log-info (str "sx:route client+cache " pathname))
|
|
(swap-rendered-content target rendered pathname)
|
|
true)))))
|
|
;; Cache miss: fetch, cache, render
|
|
(do
|
|
(log-info (str "sx:route client+data " pathname))
|
|
(resolve-page-data page-name params
|
|
(fn ((data :as dict))
|
|
(page-data-cache-set cache-key data)
|
|
(let ((env (merge closure params data)))
|
|
(if has-io
|
|
;; Async render (data+IO)
|
|
(try-async-eval-content content-src env
|
|
(fn (rendered)
|
|
(if (nil? rendered)
|
|
(do (log-warn (str "sx:route data+async eval failed for " pathname " — server fallback"))
|
|
(fetch-and-restore target pathname
|
|
(build-request-headers target (loaded-component-names) _css-hash) 0))
|
|
(swap-rendered-content target rendered pathname))))
|
|
;; Sync render (data only)
|
|
(let ((rendered (try-eval-content content-src env)))
|
|
(if (nil? rendered)
|
|
(do (log-warn (str "sx:route data eval failed for " pathname " — server fallback"))
|
|
(fetch-and-restore target pathname
|
|
(build-request-headers target (loaded-component-names) _css-hash) 0))
|
|
(swap-rendered-content target rendered pathname)))))))
|
|
true)))
|
|
;; Non-data page
|
|
(if has-io
|
|
;; Async render (IO only, no data)
|
|
(do
|
|
(log-info (str "sx:route client+async " pathname))
|
|
(try-async-eval-content content-src (merge closure params)
|
|
(fn (rendered)
|
|
(if (nil? rendered)
|
|
(do (log-warn (str "sx:route async eval failed for " pathname " — server fallback"))
|
|
(fetch-and-restore target pathname
|
|
(build-request-headers target (loaded-component-names) _css-hash) 0))
|
|
(swap-rendered-content target rendered pathname))))
|
|
true)
|
|
;; Pure page: render immediately
|
|
(let ((env (merge closure params))
|
|
(rendered (try-eval-content content-src env)))
|
|
(if (nil? rendered)
|
|
(do (log-info (str "sx:route server (eval failed) " pathname)) false)
|
|
(do
|
|
(swap-rendered-content target rendered pathname)
|
|
true))))))))))))))))))
|
|
|
|
|
|
(define bind-client-route-link :effects [mutation io]
|
|
(fn (link (href :as string))
|
|
;; Bind a boost link with client-side routing. If the route can be
|
|
;; rendered client-side (pure page, no :data), do so. Otherwise
|
|
;; fall back to standard server fetch via bind-boost-link.
|
|
(bind-client-route-click link href
|
|
(fn ()
|
|
;; Fallback: use standard boost link binding
|
|
(bind-boost-link link href)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; SSE processing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define process-sse :effects [mutation io]
|
|
(fn (root)
|
|
;; Find and bind SSE elements
|
|
(for-each
|
|
(fn (el)
|
|
(when (not (is-processed? el "sse"))
|
|
(mark-processed! el "sse")
|
|
(bind-sse el)))
|
|
(dom-query-all (or root (dom-body)) "[sx-sse]"))))
|
|
|
|
|
|
(define bind-sse :effects [mutation io]
|
|
(fn (el)
|
|
;; Connect to SSE endpoint and bind swap handler
|
|
(let ((url (dom-get-attr el "sx-sse")))
|
|
(when url
|
|
(let ((source (event-source-connect url el))
|
|
(event-name (parse-sse-swap el)))
|
|
(event-source-listen source event-name
|
|
(fn ((data :as string))
|
|
(bind-sse-swap el data))))))))
|
|
|
|
|
|
(define bind-sse-swap :effects [mutation io]
|
|
(fn (el (data :as string))
|
|
;; Handle an SSE event: swap data into element
|
|
(let ((target (resolve-target el))
|
|
(swap-spec (parse-swap-spec
|
|
(dom-get-attr el "sx-swap")
|
|
(dom-has-class? (dom-body) "sx-transitions")))
|
|
(swap-style (get swap-spec "style"))
|
|
(use-transition (get swap-spec "transition"))
|
|
(trimmed (trim data)))
|
|
(when (not (empty? trimmed))
|
|
(dispose-islands-in target)
|
|
(if (starts-with? trimmed "(")
|
|
;; SX response
|
|
(let ((rendered (sx-render trimmed))
|
|
(container (dom-create-element "div" nil)))
|
|
(dom-append container rendered)
|
|
(with-transition use-transition
|
|
(fn ()
|
|
(swap-dom-nodes target (children-to-fragment container) swap-style)
|
|
(post-swap target))))
|
|
;; HTML response
|
|
(with-transition use-transition
|
|
(fn ()
|
|
(swap-html-string target trimmed swap-style)
|
|
(post-swap target))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Inline event handlers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define bind-inline-handlers :effects [mutation io]
|
|
(fn (root)
|
|
;; Find elements with sx-on:* attributes and bind SX event handlers.
|
|
;; Handler bodies are SX expressions evaluated with `event` and `this`
|
|
;; bound in scope. No raw JS — handlers are pure SX.
|
|
(for-each
|
|
(fn (el)
|
|
(for-each
|
|
(fn ((attr :as list))
|
|
(let ((name (first attr))
|
|
(body (nth attr 1)))
|
|
(when (starts-with? name "sx-on:")
|
|
(let ((event-name (slice name 6)))
|
|
(when (not (is-processed? el (str "on:" event-name)))
|
|
(mark-processed! el (str "on:" event-name))
|
|
;; Parse body as SX, bind handler that evaluates it
|
|
(let ((exprs (sx-parse body)))
|
|
(dom-listen el event-name
|
|
(fn (e)
|
|
(let ((handler-env (env-extend (dict))))
|
|
(env-bind! handler-env "event" e)
|
|
(env-bind! handler-env "this" el)
|
|
(env-bind! handler-env "detail" (event-detail e))
|
|
(for-each
|
|
(fn (expr) (eval-expr expr handler-env))
|
|
exprs))))))))))
|
|
(dom-attr-list el)))
|
|
(dom-query-all (or root (dom-body)) "[sx-on\\:]"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Preload
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define bind-preload-for :effects [mutation io]
|
|
(fn (el)
|
|
;; Bind preload event listeners based on sx-preload attribute
|
|
(let ((preload-attr (dom-get-attr el "sx-preload")))
|
|
(when preload-attr
|
|
(let ((events (if (= preload-attr "mousedown")
|
|
(list "mousedown" "touchstart")
|
|
(list "mouseover")))
|
|
(debounce-ms (if (= preload-attr "mousedown") 0 100)))
|
|
;; Re-read verb info and headers at preload time, not bind time
|
|
(bind-preload el events debounce-ms
|
|
(fn ()
|
|
(let ((info (get-verb-info el)))
|
|
(when info
|
|
(do-preload (get info "url")
|
|
(build-request-headers el
|
|
(loaded-component-names) _css-hash)))))))))))
|
|
|
|
|
|
(define do-preload :effects [mutation io]
|
|
(fn ((url :as string) (headers :as dict))
|
|
;; Execute a preload fetch into the cache
|
|
(when (nil? (preload-cache-get _preload-cache url))
|
|
(fetch-preload url headers _preload-cache))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Main element processing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define VERB_SELECTOR
|
|
(str "[sx-get],[sx-post],[sx-put],[sx-delete],[sx-patch]"))
|
|
|
|
(define process-elements :effects [mutation io]
|
|
(fn (root)
|
|
;; Find all elements with sx-* verb attributes and process them.
|
|
(let ((els (dom-query-all (or root (dom-body)) VERB_SELECTOR)))
|
|
(for-each
|
|
(fn (el)
|
|
(when (not (is-processed? el "verb"))
|
|
(mark-processed! el "verb")
|
|
(process-one el)))
|
|
els))
|
|
;; Also process boost, SSE, inline handlers, emit attributes
|
|
(process-boosted root)
|
|
(process-sse root)
|
|
(bind-inline-handlers root)
|
|
(process-emit-elements root)))
|
|
|
|
|
|
(define process-one :effects [mutation io]
|
|
(fn (el)
|
|
;; Process a single element with an sx-* verb attribute
|
|
(let ((verb-info (get-verb-info el)))
|
|
(when verb-info
|
|
;; Check for disabled
|
|
(when (not (dom-has-attr? el "sx-disable"))
|
|
(bind-triggers el verb-info)
|
|
(bind-preload-for el))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; data-sx-emit — auto-dispatch custom events for lake→island bridge
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; Elements with data-sx-emit="event-name" get a click listener that
|
|
;; dispatches a CustomEvent with that name. Optional data-sx-emit-detail
|
|
;; provides JSON payload.
|
|
;;
|
|
;; Example:
|
|
;; <button data-sx-emit="cart:add"
|
|
;; data-sx-emit-detail='{"id":42,"name":"Widget"}'>
|
|
;; Add to Cart
|
|
;; </button>
|
|
;;
|
|
;; On click → dispatches CustomEvent "cart:add" with detail {id:42, name:"Widget"}
|
|
;; The event bubbles up to the island container where bridge-event catches it.
|
|
|
|
(define process-emit-elements :effects [mutation io]
|
|
(fn (root)
|
|
(let ((els (dom-query-all (or root (dom-body)) "[data-sx-emit]")))
|
|
(for-each
|
|
(fn (el)
|
|
(when (not (is-processed? el "emit"))
|
|
(mark-processed! el "emit")
|
|
(let ((event-name (dom-get-attr el "data-sx-emit")))
|
|
(when event-name
|
|
(dom-listen el "click"
|
|
(fn (e)
|
|
(let ((detail-json (dom-get-attr el "data-sx-emit-detail"))
|
|
(detail (if detail-json (json-parse detail-json) (dict))))
|
|
(dom-dispatch el event-name detail))))))))
|
|
els))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; History: popstate handler
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define handle-popstate :effects [mutation io]
|
|
(fn ((scrollY :as number))
|
|
;; Handle browser back/forward navigation.
|
|
;; Derive target from [sx-boost] container or fall back to #main-panel.
|
|
;; Try client-side route first, fall back to server fetch.
|
|
(let ((url (browser-location-href))
|
|
(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 nil))
|
|
nil))
|
|
;; Fall back to #main-panel if no sx-boost target
|
|
(target-sel (or target-sel "#main-panel"))
|
|
(target (dom-query target-sel))
|
|
(pathname (url-pathname url)))
|
|
(when target
|
|
(if (try-client-route pathname target-sel)
|
|
(browser-scroll-to 0 scrollY)
|
|
(let ((headers (build-request-headers target
|
|
(loaded-component-names) _css-hash)))
|
|
(fetch-and-restore target url headers scrollY)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Initialization
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define engine-init :effects [mutation io]
|
|
(fn ()
|
|
;; Initialize: CSS tracking, scripts, hydrate, process.
|
|
(do
|
|
(init-css-tracking)
|
|
(sx-process-scripts nil)
|
|
(sx-hydrate nil)
|
|
(process-elements nil))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Platform interface — Orchestration
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; From engine.sx (pure logic):
|
|
;; parse-trigger-spec, default-trigger, get-verb-info, classify-trigger,
|
|
;; build-request-headers, process-response-headers, parse-swap-spec,
|
|
;; parse-retry-spec, next-retry-ms, resolve-target, apply-optimistic,
|
|
;; revert-optimistic, find-oob-swaps, swap-dom-nodes, swap-html-string,
|
|
;; morph-children, handle-history, preload-cache-get, preload-cache-set,
|
|
;; should-boost-link?, should-boost-form?, parse-sse-swap, filter-params,
|
|
;; PRELOAD_TTL
|
|
;;
|
|
;; === Promises ===
|
|
;; (promise-resolve val) → resolved Promise
|
|
;; (promise-catch p fn) → p.catch(fn)
|
|
;;
|
|
;; === Abort controllers ===
|
|
;; (abort-previous el) → abort + remove controller for element
|
|
;; (track-controller el ctrl) → store controller for element
|
|
;; (abort-previous-target el) → abort + remove controller for target element
|
|
;; (track-controller-target el c) → store controller keyed by target element
|
|
;; (new-abort-controller) → new AbortController()
|
|
;; (controller-signal ctrl) → ctrl.signal
|
|
;; (abort-error? err) → boolean (err.name === "AbortError")
|
|
;;
|
|
;; === Timers ===
|
|
;; (set-timeout fn ms) → timer id
|
|
;; (set-interval fn ms) → timer id
|
|
;; (clear-timeout id) → void
|
|
;; (request-animation-frame fn) → void
|
|
;;
|
|
;; === Fetch ===
|
|
;; (fetch-request config success-fn error-fn) → Promise
|
|
;; config: dict with url, method, headers, body, signal, preloaded,
|
|
;; cross-origin
|
|
;; success-fn: (fn (resp-ok status get-header text) ...)
|
|
;; error-fn: (fn (err) ...)
|
|
;; (fetch-location url) → fetch URL and swap to boost target
|
|
;; (fetch-and-restore main url headers scroll-y) → popstate fetch+swap
|
|
;; (fetch-preload url headers cache) → preload into cache
|
|
;;
|
|
;; === Request body ===
|
|
;; (build-request-body el method url) → dict with body, url, content-type
|
|
;;
|
|
;; === Loading state ===
|
|
;; (show-indicator el) → indicator state (or nil)
|
|
;; (disable-elements el) → list of disabled elements
|
|
;; (clear-loading-state el indicator disabled-elts) → void
|
|
;;
|
|
;; === DOM extras (beyond adapter-dom.sx) ===
|
|
;; (dom-query-by-id id) → Element or nil
|
|
;; (dom-matches? el sel) → boolean
|
|
;; (dom-closest el sel) → Element or nil
|
|
;; (dom-body) → document.body
|
|
;; (dom-has-class? el cls) → boolean
|
|
;; (dom-append-to-head el) → void
|
|
;; (dom-parse-html-document text) → parsed document (DOMParser)
|
|
;; (dom-outer-html el) → string
|
|
;; (dom-body-inner-html doc) → string
|
|
;; (dom-tag-name el) → uppercase tag name
|
|
;;
|
|
;; === Events ===
|
|
;; (dom-dispatch el name detail) → boolean (dispatchEvent)
|
|
;; (dom-add-listener el event fn opts) → void
|
|
;; (prevent-default e) → void
|
|
;; (element-value el) → el.value or nil
|
|
;;
|
|
;; === Validation ===
|
|
;; (validate-for-request el) → boolean
|
|
;;
|
|
;; === View Transitions ===
|
|
;; (with-transition enabled fn) → void
|
|
;;
|
|
;; === IntersectionObserver ===
|
|
;; (observe-intersection el fn once? delay) → void
|
|
;;
|
|
;; === EventSource ===
|
|
;; (event-source-connect url el) → EventSource (with cleanup)
|
|
;; (event-source-listen source event fn) → void
|
|
;;
|
|
;; === Boost bindings ===
|
|
;; (bind-boost-link el href) → void (click handler + pushState)
|
|
;; (bind-boost-form form method action) → void (submit handler)
|
|
;; (bind-client-route-click link href fallback-fn) → void (client route click handler)
|
|
;;
|
|
;; === Inline handlers ===
|
|
;; (sx-on:* handlers are now evaluated as SX, not delegated to platform)
|
|
;;
|
|
;; === Preload ===
|
|
;; (bind-preload el events debounce-ms fn) → void
|
|
;;
|
|
;; === Processing markers ===
|
|
;; (mark-processed! el key) → void
|
|
;; (is-processed? el key) → boolean
|
|
;;
|
|
;; === Script handling ===
|
|
;; (create-script-clone script) → live script Element
|
|
;;
|
|
;; === SX API (references to Sx/SxRef object) ===
|
|
;; (sx-render source) → DOM nodes
|
|
;; (sx-process-scripts root) → void
|
|
;; (sx-hydrate root) → void
|
|
;; (loaded-component-names) → list of ~name strings
|
|
;;
|
|
;; === Response processing ===
|
|
;; (strip-component-scripts text) → cleaned text
|
|
;; (extract-response-css text) → cleaned text
|
|
;; (select-from-container el sel) → DocumentFragment
|
|
;; (children-to-fragment el) → DocumentFragment
|
|
;; (select-html-from-doc doc sel) → HTML string
|
|
;;
|
|
;; === Parsing ===
|
|
;; (try-parse-json s) → parsed value or nil
|
|
;;
|
|
;; === Client-side routing ===
|
|
;; (try-eval-content source env) → DOM node or nil (catches eval errors)
|
|
;; (try-async-eval-content source env callback) → void; async render,
|
|
;; calls (callback rendered-or-nil). Used for pages with IO deps.
|
|
;; (register-io-deps names) → void; ensure each IO name is registered
|
|
;; as a proxied IO primitive on the client. Idempotent.
|
|
;; (url-pathname href) → extract pathname from URL string
|
|
;; (resolve-page-data name params cb) → void; resolves data for a named page.
|
|
;; Platform decides transport (HTTP, cache, IPC, etc). Calls (cb data-dict)
|
|
;; when data is available. params is a dict of URL/route parameters.
|
|
;; (parse-sx-data text) → parsed SX data value, or nil on error.
|
|
;; Used by cache update to parse server-provided data in SX format.
|
|
;; (execute-action name payload on-success on-error) → void; POST to server,
|
|
;; calls (on-success data-dict) or (on-error message).
|
|
;; (try-rerender-page page-name params data) → void; re-evaluate and swap
|
|
;; the current page content with updated data bindings.
|
|
;;
|
|
;; From boot.sx:
|
|
;; _page-routes → list of route entries
|
|
;;
|
|
;; From router.sx:
|
|
;; (find-matching-route path routes) → matching entry with params, or nil
|
|
;; (parse-route-pattern pattern) → parsed pattern segments
|
|
;;
|
|
;; === Browser (via engine.sx) ===
|
|
;; (browser-location-href) → current URL string
|
|
;; (browser-navigate url) → void
|
|
;; (browser-reload) → void
|
|
;; (browser-scroll-to x y) → void
|
|
;; (browser-media-matches? query) → boolean
|
|
;; (browser-confirm msg) → boolean
|
|
;; (browser-prompt msg) → string or nil
|
|
;; (csrf-token) → string
|
|
;; (cross-origin? url) → boolean
|
|
;; (now-ms) → timestamp ms
|
|
;;
|
|
;; === Cache management ===
|
|
;; (parse-sx-data text) → parsed SX data value, or nil on error
|
|
;; (sw-post-message msg) → void; post message to active service worker
|
|
;;
|
|
;; === Offline persistence ===
|
|
;; (persist-offline-data key data) → void; write to IndexedDB
|
|
;; (retrieve-offline-data key cb) → void; read from IndexedDB, calls (cb data)
|
|
;; --------------------------------------------------------------------------
|