coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Step 16: Fix client routing — prefix-agnostic SX URL matching

Browse Source 
The /sx/ prefix mismatch: defpage declares paths like /language/docs/<slug>
but browser URLs are /sx/(language.(doc.slug)). find-matching-route used
starts-with? "/(", missing the /sx/ prefix entirely.

Fix: find-matching-route now uses (index-of path "/(") to detect the SX
URL portion regardless of prefix. Works for /sx/, /myapp/, any prefix.
No hardcoded paths.

Also fixed deps-satisfied?: nil deps (unknown) now returns false instead
of true, preventing client-side eval of pages with unresolved components.
Correctly falls back to server fetch.

Verified with Playwright: clicking "Getting Started" on the docs page now
shows "sx:route deps miss for docs-page" → "sx:route server fetch" instead
of the old "sx:route no match (51 routes)".

2 new router tests for prefix stripping. 2914/2914 total, zero failures.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-05 21:18:14 +00:00
parent 5d88b363e4
commit 9552750c4f
10 changed files with 18011 additions and 7661 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
shared/static/wasm/sx/deps.sxbc
View File

File diff suppressed because one or more lines are too long

165
shared/static/wasm/sx/orchestration.sx
View File

@@ -6,7 +6,8 @@
(import (web adapter-dom)) (import (web adapter-dom))
(import (web engine)) (import (web engine))
(define-library (web orchestration) (define-library
(web orchestration)
(export (export
_preload-cache _preload-cache
dispatch-trigger-events dispatch-trigger-events
@@ -68,9 +69,7 @@
handle-popstate handle-popstate
engine-init) engine-init)
(begin (begin
(define _preload-cache (dict)) (define _preload-cache (dict))
(define (define
dispatch-trigger-events dispatch-trigger-events
:effects (mutation io) :effects (mutation io)
@@ -83,7 +82,9 @@
(if (if
parsed parsed
(for-each (for-each
(fn ((key :as string)) (dom-dispatch el key (get parsed key))) (fn
((key :as string))
(dom-dispatch el key (get parsed key)))
(keys parsed)) (keys parsed))
(for-each (for-each
(fn (fn
@@ -94,7 +95,6 @@
(not (empty? trimmed)) (not (empty? trimmed))
(dom-dispatch el trimmed (dict))))) (dom-dispatch el trimmed (dict)))))
(split header-val ","))))))) (split header-val ",")))))))
(define (define
execute-request execute-request
:effects (mutation io) :effects (mutation io)
@@ -142,7 +142,6 @@
"SX-Prompt" "SX-Prompt"
prompt-val) prompt-val)
extraParams)))))))))))) extraParams))))))))))))
(define (define
do-fetch do-fetch
:effects (mutation io) :effects (mutation io)
@@ -254,9 +253,14 @@
(when (when
(not (abort-error? err)) (not (abort-error? err))
(log-warn (log-warn
(str "sx:fetch error " method " " final-url " — " err)) (str
"sx:fetch error "
method
" "
final-url
" — "
err))
(dom-dispatch el "sx:requestError" (dict "error" err)))))))))))) (dom-dispatch el "sx:requestError" (dict "error" err))))))))))))
(define (define
handle-fetch-success handle-fetch-success
:effects (mutation io) :effects (mutation io)
@@ -282,15 +286,27 @@
((target-el (if (get resp-headers "retarget") (dom-query (get resp-headers "retarget")) (resolve-target el))) ((target-el (if (get resp-headers "retarget") (dom-query (get resp-headers "retarget")) (resolve-target el)))
(swap-spec (swap-spec
(parse-swap-spec (parse-swap-spec
(or (get resp-headers "reswap") (dom-get-attr el "sx-swap")) (or
(get resp-headers "reswap")
(dom-get-attr el "sx-swap"))
(dom-has-class? (dom-body) "sx-transitions"))) (dom-has-class? (dom-body) "sx-transitions")))
(swap-style (get swap-spec "style")) (swap-style (get swap-spec "style"))
(use-transition (get swap-spec "transition")) (use-transition (get swap-spec "transition"))
(ct (or (get resp-headers "content-type") ""))) (ct (or (get resp-headers "content-type") "")))
(if (if
(contains? ct "text/sx") (contains? ct "text/sx")
(handle-sx-response el target-el text swap-style use-transition) (handle-sx-response
(handle-html-response el target-el text swap-style use-transition)) el
target-el
text
swap-style
use-transition)
(handle-html-response
el
target-el
text
swap-style
use-transition))
(dispatch-trigger-events el (get resp-headers "trigger-swap")) (dispatch-trigger-events el (get resp-headers "trigger-swap"))
(handle-history el url resp-headers) (handle-history el url resp-headers)
(set-timeout (set-timeout
@@ -307,7 +323,6 @@
el el
"sx:afterSwap" "sx:afterSwap"
(dict "target" target-el "swap" swap-style))))))) (dict "target" target-el "swap" swap-style)))))))
(define (define
flush-collected-styles flush-collected-styles
:effects (mutation io) :effects (mutation io)
@@ -323,7 +338,6 @@
(dom-set-attr el "data-sx-css" "true") (dom-set-attr el "data-sx-css" "true")
(dom-set-prop el "textContent" (join "" rules)) (dom-set-prop el "textContent" (join "" rules))
(dom-append-to-head el)))))) (dom-append-to-head el))))))
(define (define
handle-sx-response handle-sx-response
:effects (mutation io) :effects (mutation io)
@@ -372,7 +386,6 @@
(= swap-style "outerHTML") (= swap-style "outerHTML")
(dom-parent (or swap-result target)) (dom-parent (or swap-result target))
(or swap-result target))))))))))))))) (or swap-result target)))))))))))))))
(define (define
handle-html-response handle-html-response
:effects (mutation io) :effects (mutation io)
@@ -437,7 +450,6 @@
(children-to-fragment container) (children-to-fragment container)
swap-style) swap-style)
(post-swap target)))))))))) (post-swap target))))))))))
(define (define
handle-retry handle-retry
:effects (mutation io) :effects (mutation io)
@@ -463,7 +475,6 @@
(set-timeout (set-timeout
(fn () (do-fetch el verb method url extraParams)) (fn () (do-fetch el verb method url extraParams))
ms))))))) ms)))))))
(define (define
bind-triggers bind-triggers
:effects (mutation io) :effects (mutation io)
@@ -512,7 +523,6 @@
(= kind "event") (= kind "event")
(bind-event el (get trigger "event") mods verbInfo)))) (bind-event el (get trigger "event") mods verbInfo))))
triggers)))) triggers))))
(define (define
bind-event bind-event
:effects (mutation io) :effects (mutation io)
@@ -554,11 +564,14 @@
(when (when
(and (and
should-fire should-fire
(not (and (= event-name "click") (event-modifier-key? e)))) (not
(and (= event-name "click") (event-modifier-key? e))))
(when (when
(or (or
(= event-name "submit") (= event-name "submit")
(and (= event-name "click") (dom-has-attr? el "href"))) (and
(= event-name "click")
(dom-has-attr? el "href")))
(prevent-default e)) (prevent-default e))
(let (let
((live-info (get-verb-info el)) ((live-info (get-verb-info el))
@@ -586,7 +599,9 @@
(when (when
is-get-link is-get-link
(log-info (log-info
(str "sx:route server fetch " (get live-info "url")))) (str
"sx:route server fetch "
(get live-info "url"))))
(if (if
(get mods "delay") (get mods "delay")
(do (do
@@ -598,13 +613,13 @@
(get mods "delay")))) (get mods "delay"))))
(execute-request el nil nil)))))))) (execute-request el nil nil))))))))
(if (get mods "once") (dict "once" true) nil)))))) (if (get mods "once") (dict "once" true) nil))))))
(define (define
post-swap post-swap
:effects (mutation io) :effects (mutation io)
(fn (fn
(root) (root)
(log-info (str "post-swap: root=" (if root (dom-tag-name root) "nil"))) (log-info
(str "post-swap: root=" (if root (dom-tag-name root) "nil")))
(activate-scripts root) (activate-scripts root)
(sx-process-scripts root) (sx-process-scripts root)
(sx-hydrate root) (sx-hydrate root)
@@ -612,7 +627,6 @@
(run-post-render-hooks) (run-post-render-hooks)
(flush-collected-styles) (flush-collected-styles)
(process-elements root))) (process-elements root)))
(define (define
process-settle-hooks process-settle-hooks
:effects (mutation io) :effects (mutation io)
@@ -625,7 +639,6 @@
(let (let
((exprs (sx-parse settle-expr))) ((exprs (sx-parse settle-expr)))
(for-each (fn (expr) (cek-eval expr)) exprs)))))) (for-each (fn (expr) (cek-eval expr)) exprs))))))
(define (define
activate-scripts activate-scripts
:effects (mutation io) :effects (mutation io)
@@ -647,7 +660,6 @@
(dom-set-attr live "data-sx-activated" "true") (dom-set-attr live "data-sx-activated" "true")
(dom-replace-child (dom-parent dead) live dead)))) (dom-replace-child (dom-parent dead) live dead))))
scripts))))) scripts)))))
(define (define
process-oob-swaps process-oob-swaps
:effects (mutation io) :effects (mutation io)
@@ -668,7 +680,6 @@
(dom-remove-child (dom-parent oob-el) oob-el)) (dom-remove-child (dom-parent oob-el) oob-el))
(when target (swap-fn target oob-el swap-type)))) (when target (swap-fn target oob-el swap-type))))
oobs)))) oobs))))
(define (define
hoist-head-elements hoist-head-elements
:effects (mutation io) :effects (mutation io)
@@ -685,10 +696,11 @@
(for-each (for-each
(fn (fn
(link) (link)
(when (dom-parent link) (dom-remove-child (dom-parent link) link)) (when
(dom-parent link)
(dom-remove-child (dom-parent link) link))
(dom-append-to-head link)) (dom-append-to-head link))
(dom-query-all container "link[rel=\"stylesheet\"]")))) (dom-query-all container "link[rel=\"stylesheet\"]"))))
(define (define
process-boosted process-boosted
:effects (mutation io) :effects (mutation io)
@@ -697,7 +709,6 @@
(for-each (for-each
(fn (container) (boost-descendants container)) (fn (container) (boost-descendants container))
(dom-query-all (or root (dom-body)) "[sx-boost]")))) (dom-query-all (or root (dom-body)) "[sx-boost]"))))
(define (define
boost-descendants boost-descendants
:effects (mutation io) :effects (mutation io)
@@ -738,7 +749,9 @@
(let (let
((method (upper (or (dom-get-attr form "method") "GET"))) ((method (upper (or (dom-get-attr form "method") "GET")))
(action (action
(or (dom-get-attr form "action") (browser-location-href)))) (or
(dom-get-attr form "action")
(browser-location-href))))
(when (when
(and (and
(not (dom-has-attr? form "sx-target")) (not (dom-has-attr? form "sx-target"))
@@ -750,11 +763,8 @@
(dom-set-attr form "sx-swap" "innerHTML")) (dom-set-attr form "sx-swap" "innerHTML"))
(bind-boost-form form method action)))) (bind-boost-form form method action))))
(dom-query-all container "form"))))) (dom-query-all container "form")))))
(define _page-data-cache (dict)) (define _page-data-cache (dict))
(define _page-data-cache-ttl 30000) (define _page-data-cache-ttl 30000)
(define (define
page-data-cache-key page-data-cache-key
:effects () :effects ()
@@ -773,7 +783,6 @@
(append! parts (str k "=" (get params k)))) (append! parts (str k "=" (get params k))))
(keys params)) (keys params))
(str base ":" (join "&" parts))))))) (str base ":" (join "&" parts)))))))
(define (define
page-data-cache-get page-data-cache-get
:effects (mutation io) :effects (mutation io)
@@ -788,14 +797,12 @@
(> (- (now-ms) (get entry "ts")) _page-data-cache-ttl) (> (- (now-ms) (get entry "ts")) _page-data-cache-ttl)
(do (dict-set! _page-data-cache cache-key nil) nil) (do (dict-set! _page-data-cache cache-key nil) nil)
(get entry "data")))))) (get entry "data"))))))
(define (define
page-data-cache-set page-data-cache-set
:effects (mutation io) :effects (mutation io)
(fn (fn
((cache-key :as string) data) ((cache-key :as string) data)
(dict-set! _page-data-cache cache-key {:data data :ts (now-ms)}))) (dict-set! _page-data-cache cache-key {:data data :ts (now-ms)})))
(define (define
invalidate-page-cache invalidate-page-cache
:effects (mutation io) :effects (mutation io)
@@ -810,7 +817,6 @@
(keys _page-data-cache)) (keys _page-data-cache))
(sw-post-message {:type "invalidate" :page page-name}) (sw-post-message {:type "invalidate" :page page-name})
(log-info (str "sx:cache invalidate " page-name)))) (log-info (str "sx:cache invalidate " page-name))))
(define (define
invalidate-all-page-cache invalidate-all-page-cache
:effects (mutation io) :effects (mutation io)
@@ -819,7 +825,6 @@
(set! _page-data-cache (dict)) (set! _page-data-cache (dict))
(sw-post-message {:type "invalidate" :page "*"}) (sw-post-message {:type "invalidate" :page "*"})
(log-info "sx:cache invalidate *"))) (log-info "sx:cache invalidate *")))
(define (define
update-page-cache update-page-cache
:effects (mutation io) :effects (mutation io)
@@ -829,7 +834,6 @@
((cache-key (page-data-cache-key page-name (dict)))) ((cache-key (page-data-cache-key page-name (dict))))
(page-data-cache-set cache-key data) (page-data-cache-set cache-key data)
(log-info (str "sx:cache update " page-name))))) (log-info (str "sx:cache update " page-name)))))
(define (define
process-cache-directives process-cache-directives
:effects (mutation io) :effects (mutation io)
@@ -858,9 +862,7 @@
(let (let
((data (parse-sx-data response-text))) ((data (parse-sx-data response-text)))
(when data (update-page-cache hdr-update data))))))) (when data (update-page-cache hdr-update data)))))))
(define _optimistic-snapshots (dict)) (define _optimistic-snapshots (dict))
(define (define
optimistic-cache-update optimistic-cache-update
:effects (mutation) :effects (mutation)
@@ -875,7 +877,6 @@
(dict-set! _optimistic-snapshots cache-key cached) (dict-set! _optimistic-snapshots cache-key cached)
(page-data-cache-set cache-key predicted) (page-data-cache-set cache-key predicted)
predicted))))) predicted)))))
(define (define
optimistic-cache-revert optimistic-cache-revert
:effects (mutation) :effects (mutation)
@@ -888,14 +889,12 @@
(page-data-cache-set cache-key snapshot) (page-data-cache-set cache-key snapshot)
(dict-delete! _optimistic-snapshots cache-key) (dict-delete! _optimistic-snapshots cache-key)
snapshot)))) snapshot))))
(define (define
optimistic-cache-confirm optimistic-cache-confirm
:effects (mutation) :effects (mutation)
(fn (fn
((cache-key :as string)) ((cache-key :as string))
(dict-delete! _optimistic-snapshots cache-key))) (dict-delete! _optimistic-snapshots cache-key)))
(define (define
submit-mutation submit-mutation
:effects (mutation io) :effects (mutation io)
@@ -925,20 +924,16 @@
(let (let
((reverted (optimistic-cache-revert cache-key))) ((reverted (optimistic-cache-revert cache-key)))
(when reverted (try-rerender-page page-name params reverted)) (when reverted (try-rerender-page page-name params reverted))
(log-warn (str "sx:optimistic reverted " page-name ": " error)) (log-warn
(str "sx:optimistic reverted " page-name ": " error))
(when on-complete (on-complete "reverted")))))))) (when on-complete (on-complete "reverted"))))))))
(define _is-online true) (define _is-online true)
(define _offline-queue (list)) (define _offline-queue (list))
(define offline-is-online? :effects (io) (fn () _is-online)) (define offline-is-online? :effects (io) (fn () _is-online))
(define (define
offline-set-online! offline-set-online!
:effects (mutation) :effects (mutation)
(fn ((val :as boolean)) (set! _is-online val))) (fn ((val :as boolean)) (set! _is-online val)))
(define (define
offline-queue-mutation offline-queue-mutation
:effects (mutation io) :effects (mutation io)
@@ -976,7 +971,6 @@
(len _offline-queue) (len _offline-queue)
" pending)")) " pending)"))
entry))) entry)))
(define (define
offline-sync offline-sync
:effects (mutation io) :effects (mutation io)
@@ -996,7 +990,8 @@
(fn (fn
(result) (result)
(dict-set! entry "status" "synced") (dict-set! entry "status" "synced")
(log-info (str "sx:offline synced " (get entry "action")))) (log-info
(str "sx:offline synced " (get entry "action"))))
(fn (fn
((error :as string)) ((error :as string))
(dict-set! entry "status" "failed") (dict-set! entry "status" "failed")
@@ -1007,7 +1002,6 @@
": " ": "
error))))) error)))))
pending))))) pending)))))
(define (define
offline-pending-count offline-pending-count
:effects (io) :effects (io)
@@ -1017,7 +1011,6 @@
(filter (filter
(fn ((e :as dict)) (= (get e "status") "pending")) (fn ((e :as dict)) (= (get e "status") "pending"))
_offline-queue)))) _offline-queue))))
(define (define
offline-aware-mutation offline-aware-mutation
:effects (mutation io) :effects (mutation io)
@@ -1045,7 +1038,6 @@
params params
mutator-fn) mutator-fn)
(when on-complete (on-complete "queued")))))) (when on-complete (on-complete "queued"))))))
(define (define
current-page-layout current-page-layout
:effects (io) :effects (io)
@@ -1055,7 +1047,6 @@
((pathname (url-pathname (browser-location-href))) ((pathname (url-pathname (browser-location-href)))
(match (find-matching-route pathname _page-routes))) (match (find-matching-route pathname _page-routes)))
(if (nil? match) "" (or (get match "layout") ""))))) (if (nil? match) "" (or (get match "layout") "")))))
(define (define
swap-rendered-content swap-rendered-content
:effects (mutation io) :effects (mutation io)
@@ -1088,9 +1079,11 @@
(sx-hydrate-elements target) (sx-hydrate-elements target)
(sx-hydrate-islands target) (sx-hydrate-islands target)
(run-post-render-hooks) (run-post-render-hooks)
(dom-dispatch target "sx:clientRoute" (dict "pathname" pathname)) (dom-dispatch
target
"sx:clientRoute"
(dict "pathname" pathname))
(log-info (str "sx:route client " pathname)))))))) (log-info (str "sx:route client " pathname))))))))
(define (define
resolve-route-target resolve-route-target
:effects (io) :effects (io)
@@ -1100,7 +1093,6 @@
(and target-sel (not (= target-sel "true"))) (and target-sel (not (= target-sel "true")))
(dom-query target-sel) (dom-query target-sel)
nil))) nil)))
(define (define
deps-satisfied? deps-satisfied?
:effects (io) :effects (io)
@@ -1109,10 +1101,12 @@
(let (let
((deps (get match "deps")) (loaded (loaded-component-names))) ((deps (get match "deps")) (loaded (loaded-component-names)))
(if (if
(or (nil? deps) (empty? deps)) (nil? deps)
false
(if
(empty? deps)
true true
(every? (fn ((dep :as string)) (contains? loaded dep)) deps))))) (every? (fn ((dep :as string)) (contains? loaded dep)) deps))))))
(define (define
try-client-route try-client-route
:effects (mutation io) :effects (mutation io)
@@ -1166,7 +1160,8 @@
(if (if
(not (deps-satisfied? match)) (not (deps-satisfied? match))
(do (do
(log-info (str "sx:route deps miss for " page-name)) (log-info
(str "sx:route deps miss for " page-name))
false) false)
(let (let
((io-deps (get match "io-deps")) ((io-deps (get match "io-deps"))
@@ -1176,7 +1171,8 @@
render-plan render-plan
(let (let
((srv (or (get render-plan "server") (list))) ((srv (or (get render-plan "server") (list)))
(cli (or (get render-plan "client") (list)))) (cli
(or (get render-plan "client") (list))))
(log-info (log-info
(str (str
"sx:route plan " "sx:route plan "
@@ -1190,7 +1186,8 @@
(if (if
(get match "stream") (get match "stream")
(do (do
(log-info (str "sx:route streaming " pathname)) (log-info
(str "sx:route streaming " pathname))
(fetch-streaming (fetch-streaming
target target
pathname pathname
@@ -1366,14 +1363,15 @@
rendered rendered
pathname) pathname)
true)))))))))))))))))) true))))))))))))))))))
(define (define
bind-client-route-link bind-client-route-link
:effects (mutation io) :effects (mutation io)
(fn (fn
(link (href :as string)) (link (href :as string))
(bind-client-route-click link href (fn () (bind-boost-link link href))))) (bind-client-route-click
link
href
(fn () (bind-boost-link link href)))))
(define (define
process-sse process-sse
:effects (mutation io) :effects (mutation io)
@@ -1387,7 +1385,6 @@
(mark-processed! el "sse") (mark-processed! el "sse")
(bind-sse el))) (bind-sse el)))
(dom-query-all (or root (dom-body)) "[sx-sse]")))) (dom-query-all (or root (dom-body)) "[sx-sse]"))))
(define (define
bind-sse bind-sse
:effects (mutation io) :effects (mutation io)
@@ -1404,7 +1401,6 @@
source source
event-name event-name
(fn ((data :as string)) (bind-sse-swap el data)))))))) (fn ((data :as string)) (bind-sse-swap el data))))))))
(define (define
bind-sse-swap bind-sse-swap
:effects (mutation io) :effects (mutation io)
@@ -1443,7 +1439,6 @@
() ()
(swap-html-string target trimmed swap-style) (swap-html-string target trimmed swap-style)
(post-swap target)))))))) (post-swap target))))))))
(define (define
bind-inline-handlers bind-inline-handlers
:effects (mutation io) :effects (mutation io)
@@ -1472,7 +1467,11 @@
(fn (fn
(e) (e)
(host-call (host-call
(host-call (dom-window) "Function" "event" body) (host-call
(dom-window)
"Function"
"event"
body)
"call" "call"
el el
e)) e))
@@ -1493,7 +1492,6 @@
exprs))))))))))) exprs)))))))))))
(dom-attr-list el))) (dom-attr-list el)))
(dom-query-all (or root (dom-body)) "[sx-on\\:]")))) (dom-query-all (or root (dom-body)) "[sx-on\\:]"))))
(define (define
bind-preload-for bind-preload-for
:effects (mutation io) :effects (mutation io)
@@ -1519,7 +1517,6 @@
(do-preload (do-preload
(get info "url") (get info "url")
(build-request-headers el (loaded-component-names)))))))))))) (build-request-headers el (loaded-component-names))))))))))))
(define (define
do-preload do-preload
:effects (mutation io) :effects (mutation io)
@@ -1528,11 +1525,9 @@
(when (when
(nil? (preload-cache-get _preload-cache url)) (nil? (preload-cache-get _preload-cache url))
(fetch-preload url headers _preload-cache)))) (fetch-preload url headers _preload-cache))))
(define (define
VERB_SELECTOR VERB_SELECTOR
(str "[sx-get],[sx-post],[sx-put],[sx-delete],[sx-patch]")) (str "[sx-get],[sx-post],[sx-put],[sx-delete],[sx-patch]"))
(define (define
process-elements process-elements
:effects (mutation io) :effects (mutation io)
@@ -1552,7 +1547,6 @@
(process-sse root) (process-sse root)
(bind-inline-handlers root) (bind-inline-handlers root)
(process-emit-elements root))) (process-emit-elements root)))
(define (define
process-one process-one
:effects (mutation io) :effects (mutation io)
@@ -1566,7 +1560,6 @@
(not (dom-has-attr? el "sx-disable")) (not (dom-has-attr? el "sx-disable"))
(do (bind-triggers el verb-info) (bind-preload-for el)) (do (bind-triggers el verb-info) (bind-preload-for el))
(bind-preload-for el)))))) (bind-preload-for el))))))
(define (define
process-emit-elements process-emit-elements
:effects (mutation io) :effects (mutation io)
@@ -1592,10 +1585,12 @@
(let (let
((detail-json (dom-get-attr el "data-sx-emit-detail")) ((detail-json (dom-get-attr el "data-sx-emit-detail"))
(detail (detail
(if detail-json (json-parse detail-json) (dict)))) (if
detail-json
(json-parse detail-json)
(dict))))
(dom-dispatch el event-name detail)))))))) (dom-dispatch el event-name detail))))))))
els)))) els))))
(define (define
save-scroll-position save-scroll-position
:effects (io) :effects (io)
@@ -1607,7 +1602,6 @@
(dict "scrollY" scrollY) (dict "scrollY" scrollY)
"" ""
(browser-location-href))))) (browser-location-href)))))
(define (define
handle-popstate handle-popstate
:effects (mutation io) :effects (mutation io)
@@ -1630,16 +1624,15 @@
(let (let
((headers (dict "SX-Request" "true"))) ((headers (dict "SX-Request" "true")))
(fetch-and-restore target url headers scrollY)))))) (fetch-and-restore target url headers scrollY))))))
(define (define
engine-init engine-init
:effects (mutation io) :effects (mutation io)
(fn (fn
() ()
(do (sx-process-scripts nil) (sx-hydrate nil) (process-elements nil)))) (do
(sx-process-scripts nil)
(sx-hydrate nil)
)) ;; end define-library (process-elements nil)))))) ;; end define-library
;; Re-export to global namespace for backward compatibility ;; Re-export to global namespace for backward compatibility
(import (web orchestration)) (import (web orchestration))

4
shared/static/wasm/sx/orchestration.sxbc
View File

File diff suppressed because one or more lines are too long

989
shared/static/wasm/sx/router.sx
View File

File diff suppressed because it is too large Load Diff

4
shared/static/wasm/sx/router.sxbc
View File

File diff suppressed because one or more lines are too long

17400
shared/static/wasm/sx_browser.bc.js
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx_browser.bc.wasm.js
View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create}; blake2_js_for_wasm_create: blake2_js_for_wasm_create};
} }
(globalThis)) (globalThis))
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["sx-7dd7570e",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-19f4e198",[2,3,5]],["std_exit-10fb8830",[2]],["start-f5d3f095",0]],"generated":(b=>{var ({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-1549dd9c",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-cb04d103",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new

165
web/orchestration.sx
View File

@@ -6,7 +6,8 @@
(import (web adapter-dom)) (import (web adapter-dom))
(import (web engine)) (import (web engine))
(define-library (web orchestration) (define-library
(web orchestration)
(export (export
_preload-cache _preload-cache
dispatch-trigger-events dispatch-trigger-events
@@ -68,9 +69,7 @@
handle-popstate handle-popstate
engine-init) engine-init)
(begin (begin
(define _preload-cache (dict)) (define _preload-cache (dict))
(define (define
dispatch-trigger-events dispatch-trigger-events
:effects (mutation io) :effects (mutation io)
@@ -83,7 +82,9 @@
(if (if
parsed parsed
(for-each (for-each
(fn ((key :as string)) (dom-dispatch el key (get parsed key))) (fn
((key :as string))
(dom-dispatch el key (get parsed key)))
(keys parsed)) (keys parsed))
(for-each (for-each
(fn (fn
@@ -94,7 +95,6 @@
(not (empty? trimmed)) (not (empty? trimmed))
(dom-dispatch el trimmed (dict))))) (dom-dispatch el trimmed (dict)))))
(split header-val ","))))))) (split header-val ",")))))))
(define (define
execute-request execute-request
:effects (mutation io) :effects (mutation io)
@@ -142,7 +142,6 @@
"SX-Prompt" "SX-Prompt"
prompt-val) prompt-val)
extraParams)))))))))))) extraParams))))))))))))
(define (define
do-fetch do-fetch
:effects (mutation io) :effects (mutation io)
@@ -254,9 +253,14 @@
(when (when
(not (abort-error? err)) (not (abort-error? err))
(log-warn (log-warn
(str "sx:fetch error " method " " final-url " — " err)) (str
"sx:fetch error "
method
" "
final-url
" — "
err))
(dom-dispatch el "sx:requestError" (dict "error" err)))))))))))) (dom-dispatch el "sx:requestError" (dict "error" err))))))))))))
(define (define
handle-fetch-success handle-fetch-success
:effects (mutation io) :effects (mutation io)
@@ -282,15 +286,27 @@
((target-el (if (get resp-headers "retarget") (dom-query (get resp-headers "retarget")) (resolve-target el))) ((target-el (if (get resp-headers "retarget") (dom-query (get resp-headers "retarget")) (resolve-target el)))
(swap-spec (swap-spec
(parse-swap-spec (parse-swap-spec
(or (get resp-headers "reswap") (dom-get-attr el "sx-swap")) (or
(get resp-headers "reswap")
(dom-get-attr el "sx-swap"))
(dom-has-class? (dom-body) "sx-transitions"))) (dom-has-class? (dom-body) "sx-transitions")))
(swap-style (get swap-spec "style")) (swap-style (get swap-spec "style"))
(use-transition (get swap-spec "transition")) (use-transition (get swap-spec "transition"))
(ct (or (get resp-headers "content-type") ""))) (ct (or (get resp-headers "content-type") "")))
(if (if
(contains? ct "text/sx") (contains? ct "text/sx")
(handle-sx-response el target-el text swap-style use-transition) (handle-sx-response
(handle-html-response el target-el text swap-style use-transition)) el
target-el
text
swap-style
use-transition)
(handle-html-response
el
target-el
text
swap-style
use-transition))
(dispatch-trigger-events el (get resp-headers "trigger-swap")) (dispatch-trigger-events el (get resp-headers "trigger-swap"))
(handle-history el url resp-headers) (handle-history el url resp-headers)
(set-timeout (set-timeout
@@ -307,7 +323,6 @@
el el
"sx:afterSwap" "sx:afterSwap"
(dict "target" target-el "swap" swap-style))))))) (dict "target" target-el "swap" swap-style)))))))
(define (define
flush-collected-styles flush-collected-styles
:effects (mutation io) :effects (mutation io)
@@ -323,7 +338,6 @@
(dom-set-attr el "data-sx-css" "true") (dom-set-attr el "data-sx-css" "true")
(dom-set-prop el "textContent" (join "" rules)) (dom-set-prop el "textContent" (join "" rules))
(dom-append-to-head el)))))) (dom-append-to-head el))))))
(define (define
handle-sx-response handle-sx-response
:effects (mutation io) :effects (mutation io)
@@ -372,7 +386,6 @@
(= swap-style "outerHTML") (= swap-style "outerHTML")
(dom-parent (or swap-result target)) (dom-parent (or swap-result target))
(or swap-result target))))))))))))))) (or swap-result target)))))))))))))))
(define (define
handle-html-response handle-html-response
:effects (mutation io) :effects (mutation io)
@@ -437,7 +450,6 @@
(children-to-fragment container) (children-to-fragment container)
swap-style) swap-style)
(post-swap target)))))))))) (post-swap target))))))))))
(define (define
handle-retry handle-retry
:effects (mutation io) :effects (mutation io)
@@ -463,7 +475,6 @@
(set-timeout (set-timeout
(fn () (do-fetch el verb method url extraParams)) (fn () (do-fetch el verb method url extraParams))
ms))))))) ms)))))))
(define (define
bind-triggers bind-triggers
:effects (mutation io) :effects (mutation io)
@@ -512,7 +523,6 @@
(= kind "event") (= kind "event")
(bind-event el (get trigger "event") mods verbInfo)))) (bind-event el (get trigger "event") mods verbInfo))))
triggers)))) triggers))))
(define (define
bind-event bind-event
:effects (mutation io) :effects (mutation io)
@@ -554,11 +564,14 @@
(when (when
(and (and
should-fire should-fire
(not (and (= event-name "click") (event-modifier-key? e)))) (not
(and (= event-name "click") (event-modifier-key? e))))
(when (when
(or (or
(= event-name "submit") (= event-name "submit")
(and (= event-name "click") (dom-has-attr? el "href"))) (and
(= event-name "click")
(dom-has-attr? el "href")))
(prevent-default e)) (prevent-default e))
(let (let
((live-info (get-verb-info el)) ((live-info (get-verb-info el))
@@ -586,7 +599,9 @@
(when (when
is-get-link is-get-link
(log-info (log-info
(str "sx:route server fetch " (get live-info "url")))) (str
"sx:route server fetch "
(get live-info "url"))))
(if (if
(get mods "delay") (get mods "delay")
(do (do
@@ -598,13 +613,13 @@
(get mods "delay")))) (get mods "delay"))))
(execute-request el nil nil)))))))) (execute-request el nil nil))))))))
(if (get mods "once") (dict "once" true) nil)))))) (if (get mods "once") (dict "once" true) nil))))))
(define (define
post-swap post-swap
:effects (mutation io) :effects (mutation io)
(fn (fn
(root) (root)
(log-info (str "post-swap: root=" (if root (dom-tag-name root) "nil"))) (log-info
(str "post-swap: root=" (if root (dom-tag-name root) "nil")))
(activate-scripts root) (activate-scripts root)
(sx-process-scripts root) (sx-process-scripts root)
(sx-hydrate root) (sx-hydrate root)
@@ -612,7 +627,6 @@
(run-post-render-hooks) (run-post-render-hooks)
(flush-collected-styles) (flush-collected-styles)
(process-elements root))) (process-elements root)))
(define (define
process-settle-hooks process-settle-hooks
:effects (mutation io) :effects (mutation io)
@@ -625,7 +639,6 @@
(let (let
((exprs (sx-parse settle-expr))) ((exprs (sx-parse settle-expr)))
(for-each (fn (expr) (cek-eval expr)) exprs)))))) (for-each (fn (expr) (cek-eval expr)) exprs))))))
(define (define
activate-scripts activate-scripts
:effects (mutation io) :effects (mutation io)
@@ -647,7 +660,6 @@
(dom-set-attr live "data-sx-activated" "true") (dom-set-attr live "data-sx-activated" "true")
(dom-replace-child (dom-parent dead) live dead)))) (dom-replace-child (dom-parent dead) live dead))))
scripts))))) scripts)))))
(define (define
process-oob-swaps process-oob-swaps
:effects (mutation io) :effects (mutation io)
@@ -668,7 +680,6 @@
(dom-remove-child (dom-parent oob-el) oob-el)) (dom-remove-child (dom-parent oob-el) oob-el))
(when target (swap-fn target oob-el swap-type)))) (when target (swap-fn target oob-el swap-type))))
oobs)))) oobs))))
(define (define
hoist-head-elements hoist-head-elements
:effects (mutation io) :effects (mutation io)
@@ -685,10 +696,11 @@
(for-each (for-each
(fn (fn
(link) (link)
(when (dom-parent link) (dom-remove-child (dom-parent link) link)) (when
(dom-parent link)
(dom-remove-child (dom-parent link) link))
(dom-append-to-head link)) (dom-append-to-head link))
(dom-query-all container "link[rel=\"stylesheet\"]")))) (dom-query-all container "link[rel=\"stylesheet\"]"))))
(define (define
process-boosted process-boosted
:effects (mutation io) :effects (mutation io)
@@ -697,7 +709,6 @@
(for-each (for-each
(fn (container) (boost-descendants container)) (fn (container) (boost-descendants container))
(dom-query-all (or root (dom-body)) "[sx-boost]")))) (dom-query-all (or root (dom-body)) "[sx-boost]"))))
(define (define
boost-descendants boost-descendants
:effects (mutation io) :effects (mutation io)
@@ -738,7 +749,9 @@
(let (let
((method (upper (or (dom-get-attr form "method") "GET"))) ((method (upper (or (dom-get-attr form "method") "GET")))
(action (action
(or (dom-get-attr form "action") (browser-location-href)))) (or
(dom-get-attr form "action")
(browser-location-href))))
(when (when
(and (and
(not (dom-has-attr? form "sx-target")) (not (dom-has-attr? form "sx-target"))
@@ -750,11 +763,8 @@
(dom-set-attr form "sx-swap" "innerHTML")) (dom-set-attr form "sx-swap" "innerHTML"))
(bind-boost-form form method action)))) (bind-boost-form form method action))))
(dom-query-all container "form"))))) (dom-query-all container "form")))))
(define _page-data-cache (dict)) (define _page-data-cache (dict))
(define _page-data-cache-ttl 30000) (define _page-data-cache-ttl 30000)
(define (define
page-data-cache-key page-data-cache-key
:effects () :effects ()
@@ -773,7 +783,6 @@
(append! parts (str k "=" (get params k)))) (append! parts (str k "=" (get params k))))
(keys params)) (keys params))
(str base ":" (join "&" parts))))))) (str base ":" (join "&" parts)))))))
(define (define
page-data-cache-get page-data-cache-get
:effects (mutation io) :effects (mutation io)
@@ -788,14 +797,12 @@
(> (- (now-ms) (get entry "ts")) _page-data-cache-ttl) (> (- (now-ms) (get entry "ts")) _page-data-cache-ttl)
(do (dict-set! _page-data-cache cache-key nil) nil) (do (dict-set! _page-data-cache cache-key nil) nil)
(get entry "data")))))) (get entry "data"))))))
(define (define
page-data-cache-set page-data-cache-set
:effects (mutation io) :effects (mutation io)
(fn (fn
((cache-key :as string) data) ((cache-key :as string) data)
(dict-set! _page-data-cache cache-key {:data data :ts (now-ms)}))) (dict-set! _page-data-cache cache-key {:data data :ts (now-ms)})))
(define (define
invalidate-page-cache invalidate-page-cache
:effects (mutation io) :effects (mutation io)
@@ -810,7 +817,6 @@
(keys _page-data-cache)) (keys _page-data-cache))
(sw-post-message {:type "invalidate" :page page-name}) (sw-post-message {:type "invalidate" :page page-name})
(log-info (str "sx:cache invalidate " page-name)))) (log-info (str "sx:cache invalidate " page-name))))
(define (define
invalidate-all-page-cache invalidate-all-page-cache
:effects (mutation io) :effects (mutation io)
@@ -819,7 +825,6 @@
(set! _page-data-cache (dict)) (set! _page-data-cache (dict))
(sw-post-message {:type "invalidate" :page "*"}) (sw-post-message {:type "invalidate" :page "*"})
(log-info "sx:cache invalidate *"))) (log-info "sx:cache invalidate *")))
(define (define
update-page-cache update-page-cache
:effects (mutation io) :effects (mutation io)
@@ -829,7 +834,6 @@
((cache-key (page-data-cache-key page-name (dict)))) ((cache-key (page-data-cache-key page-name (dict))))
(page-data-cache-set cache-key data) (page-data-cache-set cache-key data)
(log-info (str "sx:cache update " page-name))))) (log-info (str "sx:cache update " page-name)))))
(define (define
process-cache-directives process-cache-directives
:effects (mutation io) :effects (mutation io)
@@ -858,9 +862,7 @@
(let (let
((data (parse-sx-data response-text))) ((data (parse-sx-data response-text)))
(when data (update-page-cache hdr-update data))))))) (when data (update-page-cache hdr-update data)))))))
(define _optimistic-snapshots (dict)) (define _optimistic-snapshots (dict))
(define (define
optimistic-cache-update optimistic-cache-update
:effects (mutation) :effects (mutation)
@@ -875,7 +877,6 @@
(dict-set! _optimistic-snapshots cache-key cached) (dict-set! _optimistic-snapshots cache-key cached)
(page-data-cache-set cache-key predicted) (page-data-cache-set cache-key predicted)
predicted))))) predicted)))))
(define (define
optimistic-cache-revert optimistic-cache-revert
:effects (mutation) :effects (mutation)
@@ -888,14 +889,12 @@
(page-data-cache-set cache-key snapshot) (page-data-cache-set cache-key snapshot)
(dict-delete! _optimistic-snapshots cache-key) (dict-delete! _optimistic-snapshots cache-key)
snapshot)))) snapshot))))
(define (define
optimistic-cache-confirm optimistic-cache-confirm
:effects (mutation) :effects (mutation)
(fn (fn
((cache-key :as string)) ((cache-key :as string))
(dict-delete! _optimistic-snapshots cache-key))) (dict-delete! _optimistic-snapshots cache-key)))
(define (define
submit-mutation submit-mutation
:effects (mutation io) :effects (mutation io)
@@ -925,20 +924,16 @@
(let (let
((reverted (optimistic-cache-revert cache-key))) ((reverted (optimistic-cache-revert cache-key)))
(when reverted (try-rerender-page page-name params reverted)) (when reverted (try-rerender-page page-name params reverted))
(log-warn (str "sx:optimistic reverted " page-name ": " error)) (log-warn
(str "sx:optimistic reverted " page-name ": " error))
(when on-complete (on-complete "reverted")))))))) (when on-complete (on-complete "reverted"))))))))
(define _is-online true) (define _is-online true)
(define _offline-queue (list)) (define _offline-queue (list))
(define offline-is-online? :effects (io) (fn () _is-online)) (define offline-is-online? :effects (io) (fn () _is-online))
(define (define
offline-set-online! offline-set-online!
:effects (mutation) :effects (mutation)
(fn ((val :as boolean)) (set! _is-online val))) (fn ((val :as boolean)) (set! _is-online val)))
(define (define
offline-queue-mutation offline-queue-mutation
:effects (mutation io) :effects (mutation io)
@@ -976,7 +971,6 @@
(len _offline-queue) (len _offline-queue)
" pending)")) " pending)"))
entry))) entry)))
(define (define
offline-sync offline-sync
:effects (mutation io) :effects (mutation io)
@@ -996,7 +990,8 @@
(fn (fn
(result) (result)
(dict-set! entry "status" "synced") (dict-set! entry "status" "synced")
(log-info (str "sx:offline synced " (get entry "action")))) (log-info
(str "sx:offline synced " (get entry "action"))))
(fn (fn
((error :as string)) ((error :as string))
(dict-set! entry "status" "failed") (dict-set! entry "status" "failed")
@@ -1007,7 +1002,6 @@
": " ": "
error))))) error)))))
pending))))) pending)))))
(define (define
offline-pending-count offline-pending-count
:effects (io) :effects (io)
@@ -1017,7 +1011,6 @@
(filter (filter
(fn ((e :as dict)) (= (get e "status") "pending")) (fn ((e :as dict)) (= (get e "status") "pending"))
_offline-queue)))) _offline-queue))))
(define (define
offline-aware-mutation offline-aware-mutation
:effects (mutation io) :effects (mutation io)
@@ -1045,7 +1038,6 @@
params params
mutator-fn) mutator-fn)
(when on-complete (on-complete "queued")))))) (when on-complete (on-complete "queued"))))))
(define (define
current-page-layout current-page-layout
:effects (io) :effects (io)
@@ -1055,7 +1047,6 @@
((pathname (url-pathname (browser-location-href))) ((pathname (url-pathname (browser-location-href)))
(match (find-matching-route pathname _page-routes))) (match (find-matching-route pathname _page-routes)))
(if (nil? match) "" (or (get match "layout") ""))))) (if (nil? match) "" (or (get match "layout") "")))))
(define (define
swap-rendered-content swap-rendered-content
:effects (mutation io) :effects (mutation io)
@@ -1088,9 +1079,11 @@
(sx-hydrate-elements target) (sx-hydrate-elements target)
(sx-hydrate-islands target) (sx-hydrate-islands target)
(run-post-render-hooks) (run-post-render-hooks)
(dom-dispatch target "sx:clientRoute" (dict "pathname" pathname)) (dom-dispatch
target
"sx:clientRoute"
(dict "pathname" pathname))
(log-info (str "sx:route client " pathname)))))))) (log-info (str "sx:route client " pathname))))))))
(define (define
resolve-route-target resolve-route-target
:effects (io) :effects (io)
@@ -1100,7 +1093,6 @@
(and target-sel (not (= target-sel "true"))) (and target-sel (not (= target-sel "true")))
(dom-query target-sel) (dom-query target-sel)
nil))) nil)))
(define (define
deps-satisfied? deps-satisfied?
:effects (io) :effects (io)
@@ -1109,10 +1101,12 @@
(let (let
((deps (get match "deps")) (loaded (loaded-component-names))) ((deps (get match "deps")) (loaded (loaded-component-names)))
(if (if
(or (nil? deps) (empty? deps)) (nil? deps)
false
(if
(empty? deps)
true true
(every? (fn ((dep :as string)) (contains? loaded dep)) deps))))) (every? (fn ((dep :as string)) (contains? loaded dep)) deps))))))
(define (define
try-client-route try-client-route
:effects (mutation io) :effects (mutation io)
@@ -1166,7 +1160,8 @@
(if (if
(not (deps-satisfied? match)) (not (deps-satisfied? match))
(do (do
(log-info (str "sx:route deps miss for " page-name)) (log-info
(str "sx:route deps miss for " page-name))
false) false)
(let (let
((io-deps (get match "io-deps")) ((io-deps (get match "io-deps"))
@@ -1176,7 +1171,8 @@
render-plan render-plan
(let (let
((srv (or (get render-plan "server") (list))) ((srv (or (get render-plan "server") (list)))
(cli (or (get render-plan "client") (list)))) (cli
(or (get render-plan "client") (list))))
(log-info (log-info
(str (str
"sx:route plan " "sx:route plan "
@@ -1190,7 +1186,8 @@
(if (if
(get match "stream") (get match "stream")
(do (do
(log-info (str "sx:route streaming " pathname)) (log-info
(str "sx:route streaming " pathname))
(fetch-streaming (fetch-streaming
target target
pathname pathname
@@ -1366,14 +1363,15 @@
rendered rendered
pathname) pathname)
true)))))))))))))))))) true))))))))))))))))))
(define (define
bind-client-route-link bind-client-route-link
:effects (mutation io) :effects (mutation io)
(fn (fn
(link (href :as string)) (link (href :as string))
(bind-client-route-click link href (fn () (bind-boost-link link href))))) (bind-client-route-click
link
href
(fn () (bind-boost-link link href)))))
(define (define
process-sse process-sse
:effects (mutation io) :effects (mutation io)
@@ -1387,7 +1385,6 @@
(mark-processed! el "sse") (mark-processed! el "sse")
(bind-sse el))) (bind-sse el)))
(dom-query-all (or root (dom-body)) "[sx-sse]")))) (dom-query-all (or root (dom-body)) "[sx-sse]"))))
(define (define
bind-sse bind-sse
:effects (mutation io) :effects (mutation io)
@@ -1404,7 +1401,6 @@
source source
event-name event-name
(fn ((data :as string)) (bind-sse-swap el data)))))))) (fn ((data :as string)) (bind-sse-swap el data))))))))
(define (define
bind-sse-swap bind-sse-swap
:effects (mutation io) :effects (mutation io)
@@ -1443,7 +1439,6 @@
() ()
(swap-html-string target trimmed swap-style) (swap-html-string target trimmed swap-style)
(post-swap target)))))))) (post-swap target))))))))
(define (define
bind-inline-handlers bind-inline-handlers
:effects (mutation io) :effects (mutation io)
@@ -1472,7 +1467,11 @@
(fn (fn
(e) (e)
(host-call (host-call
(host-call (dom-window) "Function" "event" body) (host-call
(dom-window)
"Function"
"event"
body)
"call" "call"
el el
e)) e))
@@ -1493,7 +1492,6 @@
exprs))))))))))) exprs)))))))))))
(dom-attr-list el))) (dom-attr-list el)))
(dom-query-all (or root (dom-body)) "[sx-on\\:]")))) (dom-query-all (or root (dom-body)) "[sx-on\\:]"))))
(define (define
bind-preload-for bind-preload-for
:effects (mutation io) :effects (mutation io)
@@ -1519,7 +1517,6 @@
(do-preload (do-preload
(get info "url") (get info "url")
(build-request-headers el (loaded-component-names)))))))))))) (build-request-headers el (loaded-component-names))))))))))))
(define (define
do-preload do-preload
:effects (mutation io) :effects (mutation io)
@@ -1528,11 +1525,9 @@
(when (when
(nil? (preload-cache-get _preload-cache url)) (nil? (preload-cache-get _preload-cache url))
(fetch-preload url headers _preload-cache)))) (fetch-preload url headers _preload-cache))))
(define (define
VERB_SELECTOR VERB_SELECTOR
(str "[sx-get],[sx-post],[sx-put],[sx-delete],[sx-patch]")) (str "[sx-get],[sx-post],[sx-put],[sx-delete],[sx-patch]"))
(define (define
process-elements process-elements
:effects (mutation io) :effects (mutation io)
@@ -1552,7 +1547,6 @@
(process-sse root) (process-sse root)
(bind-inline-handlers root) (bind-inline-handlers root)
(process-emit-elements root))) (process-emit-elements root)))
(define (define
process-one process-one
:effects (mutation io) :effects (mutation io)
@@ -1566,7 +1560,6 @@
(not (dom-has-attr? el "sx-disable")) (not (dom-has-attr? el "sx-disable"))
(do (bind-triggers el verb-info) (bind-preload-for el)) (do (bind-triggers el verb-info) (bind-preload-for el))
(bind-preload-for el)))))) (bind-preload-for el))))))
(define (define
process-emit-elements process-emit-elements
:effects (mutation io) :effects (mutation io)
@@ -1592,10 +1585,12 @@
(let (let
((detail-json (dom-get-attr el "data-sx-emit-detail")) ((detail-json (dom-get-attr el "data-sx-emit-detail"))
(detail (detail
(if detail-json (json-parse detail-json) (dict)))) (if
detail-json
(json-parse detail-json)
(dict))))
(dom-dispatch el event-name detail)))))))) (dom-dispatch el event-name detail))))))))
els)))) els))))
(define (define
save-scroll-position save-scroll-position
:effects (io) :effects (io)
@@ -1607,7 +1602,6 @@
(dict "scrollY" scrollY) (dict "scrollY" scrollY)
"" ""
(browser-location-href))))) (browser-location-href)))))
(define (define
handle-popstate handle-popstate
:effects (mutation io) :effects (mutation io)
@@ -1630,16 +1624,15 @@
(let (let
((headers (dict "SX-Request" "true"))) ((headers (dict "SX-Request" "true")))
(fetch-and-restore target url headers scrollY)))))) (fetch-and-restore target url headers scrollY))))))
(define (define
engine-init engine-init
:effects (mutation io) :effects (mutation io)
(fn (fn
() ()
(do (sx-process-scripts nil) (sx-hydrate nil) (process-elements nil)))) (do
(sx-process-scripts nil)
(sx-hydrate nil)
)) ;; end define-library (process-elements nil)))))) ;; end define-library
;; Re-export to global namespace for backward compatibility ;; Re-export to global namespace for backward compatibility
(import (web orchestration)) (import (web orchestration))

989
web/router.sx
View File

File diff suppressed because it is too large Load Diff

34
web/tests/test-router.sx
View File

@@ -208,16 +208,34 @@
;; find-matching-route with SX URLs ;; find-matching-route with SX URLs
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(defsuite "find-matching-route-sx-urls" (defsuite
(deftest "SX URL auto-converts for matching" "find-matching-route-sx-urls"
(let ((routes (list (deftest
{:pattern "/language/docs/<slug>" "SX URL auto-converts for matching"
:parsed (parse-route-pattern "/language/docs/<slug>") (let
:name "docs-page"}))) ((routes (list {:parsed (parse-route-pattern "/language/docs/<slug>") :pattern "/language/docs/<slug>" :name "docs-page"})))
(let ((result (find-matching-route "/(language.(doc.introduction))" routes))) (let
((result (find-matching-route "/(language.(doc.introduction))" routes)))
(assert-true (not (nil? result))) (assert-true (not (nil? result)))
(assert-equal "docs-page" (get result "name")) (assert-equal "docs-page" (get result "name"))
(assert-equal "introduction" (get (get result "params") "slug")))))) (assert-equal "introduction" (get (get result "params") "slug")))))
(deftest
"SX URL with /sx/ prefix auto-converts"
(let
((routes (list {:parsed (parse-route-pattern "/language/docs/<slug>") :pattern "/language/docs/<slug>" :name "docs-page"})))
(let
((result (find-matching-route "/sx/(language.(doc.introduction))" routes)))
(assert-true (not (nil? result)))
(assert-equal "docs-page" (get result "name"))
(assert-equal "introduction" (get (get result "params") "slug")))))
(deftest
"SX URL with custom prefix auto-converts"
(let
((routes (list {:parsed (parse-route-pattern "/geography/") :pattern "/geography/" :name "geo-index"})))
(let
((result (find-matching-route "/myapp/(geography)" routes)))
(assert-true (not (nil? result)))
(assert-equal "geo-index" (get result "name"))))))
;; ========================================================================== ;; ==========================================================================