giles
9552750c4f
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>
561 lines
17 KiB
Plaintext
561 lines
17 KiB
Plaintext
;; ==========================================================================
|
|
;; router.sx — Client-side route matching specification
|
|
;;
|
|
;; Pure functions for matching URL paths against Flask-style route patterns.
|
|
;; Used by client-side routing to determine if a page can be rendered
|
|
;; locally without a server roundtrip.
|
|
;;
|
|
;; All functions are pure — no IO, no platform-specific operations.
|
|
;; Uses only primitives from primitives.sx (string ops, list ops).
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 1. Split path into segments
|
|
;; --------------------------------------------------------------------------
|
|
;; "/docs/hello" → ("docs" "hello")
|
|
;; "/" → ()
|
|
;; "/docs/" → ("docs")
|
|
|
|
|
|
(define-library
|
|
(web router)
|
|
(export
|
|
split-path-segments
|
|
make-route-segment
|
|
parse-route-pattern
|
|
match-route-segments
|
|
match-route
|
|
find-matching-route
|
|
_fn-to-segment
|
|
sx-url-to-path
|
|
_count-leading-dots
|
|
_strip-trailing-close
|
|
_index-of-safe
|
|
_last-index-of
|
|
_pop-sx-url-level
|
|
_pop-sx-url-levels
|
|
_split-pos-kw
|
|
_parse-relative-body
|
|
_extract-innermost
|
|
_find-kw-in-tokens
|
|
_find-keyword-value
|
|
_replace-kw-in-tokens
|
|
_set-keyword-in-content
|
|
_is-delta-value?
|
|
_apply-delta
|
|
_apply-kw-pairs
|
|
_apply-keywords-to-url
|
|
_normalize-relative
|
|
resolve-relative-url
|
|
relative-sx-url?
|
|
_url-special-forms
|
|
url-special-form?
|
|
parse-sx-url
|
|
url-special-form-name
|
|
url-special-form-inner
|
|
url-to-expr
|
|
auto-quote-unknowns
|
|
prepare-url-expr)
|
|
(begin
|
|
(define
|
|
split-path-segments
|
|
:effects ()
|
|
(fn
|
|
((path :as string))
|
|
(let
|
|
((trimmed (if (starts-with? path "/") (slice path 1) path)))
|
|
(let
|
|
((trimmed2 (if (and (not (empty? trimmed)) (ends-with? trimmed "/")) (slice trimmed 0 (- (len trimmed) 1)) trimmed)))
|
|
(if (empty? trimmed2) (list) (split trimmed2 "/"))))))
|
|
(define
|
|
make-route-segment
|
|
:effects ()
|
|
(fn
|
|
((seg :as string))
|
|
(if
|
|
(and (starts-with? seg "<") (ends-with? seg ">"))
|
|
(let
|
|
((param-name (slice seg 1 (- (len seg) 1))))
|
|
(let
|
|
((d {}))
|
|
(dict-set! d "type" "param")
|
|
(dict-set! d "value" param-name)
|
|
d))
|
|
(let
|
|
((d {}))
|
|
(dict-set! d "type" "literal")
|
|
(dict-set! d "value" seg)
|
|
d))))
|
|
(define
|
|
parse-route-pattern
|
|
:effects ()
|
|
(fn
|
|
((pattern :as string))
|
|
(let
|
|
((segments (split-path-segments pattern)))
|
|
(map make-route-segment segments))))
|
|
(define
|
|
match-route-segments
|
|
:effects ()
|
|
(fn
|
|
((path-segs :as list) (parsed-segs :as list))
|
|
(if
|
|
(not (= (len path-segs) (len parsed-segs)))
|
|
nil
|
|
(let
|
|
((params {}) (matched true))
|
|
(for-each-indexed
|
|
(fn
|
|
((i :as number) (parsed-seg :as dict))
|
|
(when
|
|
matched
|
|
(let
|
|
((path-seg (nth path-segs i))
|
|
(seg-type (get parsed-seg "type")))
|
|
(cond
|
|
(= seg-type "literal")
|
|
(when
|
|
(not (= path-seg (get parsed-seg "value")))
|
|
(set! matched false))
|
|
(= seg-type "param")
|
|
(dict-set! params (get parsed-seg "value") path-seg)
|
|
:else (set! matched false)))))
|
|
parsed-segs)
|
|
(if matched params nil)))))
|
|
(define
|
|
match-route
|
|
:effects ()
|
|
(fn
|
|
((path :as string) (pattern :as string))
|
|
(let
|
|
((path-segs (split-path-segments path))
|
|
(parsed-segs (parse-route-pattern pattern)))
|
|
(match-route-segments path-segs parsed-segs))))
|
|
(define
|
|
find-matching-route
|
|
:effects ()
|
|
(fn
|
|
((path :as string) (routes :as list))
|
|
(let
|
|
((match-path (let ((paren-idx (index-of path "/("))) (if (> paren-idx 0) (or (sx-url-to-path (slice path paren-idx (len path))) path) (if (starts-with? path "/(") (or (sx-url-to-path path) path) path)))))
|
|
(let
|
|
((path-segs (split-path-segments match-path)) (result nil))
|
|
(for-each
|
|
(fn
|
|
((route :as dict))
|
|
(when
|
|
(nil? result)
|
|
(let
|
|
((params (match-route-segments path-segs (get route "parsed"))))
|
|
(when
|
|
(not (nil? params))
|
|
(let
|
|
((matched (merge route {})))
|
|
(dict-set! matched "params" params)
|
|
(set! result matched))))))
|
|
routes)
|
|
result))))
|
|
(define
|
|
_fn-to-segment
|
|
:effects ()
|
|
(fn
|
|
((name :as string))
|
|
(case
|
|
name
|
|
"doc"
|
|
"docs"
|
|
"spec"
|
|
"specs"
|
|
"bootstrapper"
|
|
"bootstrappers"
|
|
"test"
|
|
"testing"
|
|
"example"
|
|
"examples"
|
|
"protocol"
|
|
"protocols"
|
|
"essay"
|
|
"essays"
|
|
"plan"
|
|
"plans"
|
|
"reference-detail"
|
|
"reference"
|
|
:else name)))
|
|
(define
|
|
sx-url-to-path
|
|
:effects ()
|
|
(fn
|
|
((url :as string))
|
|
(if
|
|
(not (and (starts-with? url "/(") (ends-with? url ")")))
|
|
nil
|
|
(let
|
|
((inner (slice url 2 (- (len url) 1))))
|
|
(let
|
|
((s (replace (replace (replace inner "." "/") "(" "") ")" "")))
|
|
(let
|
|
((segs (filter (fn (s) (not (empty? s))) (split s "/"))))
|
|
(str "/" (join "/" (map _fn-to-segment segs)))))))))
|
|
(define
|
|
_count-leading-dots
|
|
:effects ()
|
|
(fn
|
|
((s :as string))
|
|
(if
|
|
(empty? s)
|
|
0
|
|
(if
|
|
(starts-with? s ".")
|
|
(+ 1 (_count-leading-dots (slice s 1)))
|
|
0))))
|
|
(define
|
|
_strip-trailing-close
|
|
:effects ()
|
|
(fn
|
|
((s :as string))
|
|
(if
|
|
(ends-with? s ")")
|
|
(_strip-trailing-close (slice s 0 (- (len s) 1)))
|
|
s)))
|
|
(define
|
|
_index-of-safe
|
|
:effects ()
|
|
(fn
|
|
((s :as string) (needle :as string))
|
|
(let
|
|
((idx (index-of s needle)))
|
|
(if (or (nil? idx) (< idx 0)) nil idx))))
|
|
(define
|
|
_last-index-of
|
|
:effects ()
|
|
(fn
|
|
((s :as string) (needle :as string))
|
|
(let
|
|
((idx (_index-of-safe s needle)))
|
|
(if
|
|
(nil? idx)
|
|
nil
|
|
(let
|
|
((rest-idx (_last-index-of (slice s (+ idx 1)) needle)))
|
|
(if (nil? rest-idx) idx (+ (+ idx 1) rest-idx)))))))
|
|
(define
|
|
_pop-sx-url-level
|
|
:effects ()
|
|
(fn
|
|
((url :as string))
|
|
(let
|
|
((stripped (_strip-trailing-close url))
|
|
(close-count (- (len url) (len (_strip-trailing-close url)))))
|
|
(if
|
|
(<= close-count 1)
|
|
"/"
|
|
(let
|
|
((last-dp (_last-index-of stripped ".(")))
|
|
(if
|
|
(nil? last-dp)
|
|
"/"
|
|
(str
|
|
(slice stripped 0 last-dp)
|
|
(slice url (- (len url) (- close-count 1))))))))))
|
|
(define
|
|
_pop-sx-url-levels
|
|
:effects ()
|
|
(fn
|
|
((url :as string) (n :as number))
|
|
(if
|
|
(<= n 0)
|
|
url
|
|
(_pop-sx-url-levels (_pop-sx-url-level url) (- n 1)))))
|
|
(define
|
|
_split-pos-kw
|
|
:effects ()
|
|
(fn
|
|
((tokens :as list) (i :as number) (pos :as list) (kw :as list))
|
|
(if
|
|
(>= i (len tokens))
|
|
{:positional (join "." pos) :keywords kw}
|
|
(let
|
|
((tok (nth tokens i)))
|
|
(if
|
|
(starts-with? tok ":")
|
|
(let
|
|
((val (if (< (+ i 1) (len tokens)) (nth tokens (+ i 1)) "")))
|
|
(_split-pos-kw
|
|
tokens
|
|
(+ i 2)
|
|
pos
|
|
(append kw (list (list tok val)))))
|
|
(_split-pos-kw tokens (+ i 1) (append pos (list tok)) kw))))))
|
|
(define
|
|
_parse-relative-body
|
|
:effects ()
|
|
(fn
|
|
((body :as string))
|
|
(if
|
|
(empty? body)
|
|
{:positional "" :keywords (list)}
|
|
(_split-pos-kw (split body ".") 0 (list) (list)))))
|
|
(define
|
|
_extract-innermost
|
|
:effects ()
|
|
(fn
|
|
((url :as string))
|
|
(let
|
|
((stripped (_strip-trailing-close url))
|
|
(suffix (slice url (len (_strip-trailing-close url)))))
|
|
(let
|
|
((last-dp (_last-index-of stripped ".(")))
|
|
(if (nil? last-dp) {:before "/(" :content (slice stripped 2) :suffix suffix} {:before (slice stripped 0 (+ last-dp 2)) :content (slice stripped (+ last-dp 2)) :suffix suffix})))))
|
|
(define
|
|
_find-kw-in-tokens
|
|
:effects ()
|
|
(fn
|
|
((tokens :as list) (i :as number) (kw :as string))
|
|
(if
|
|
(>= i (len tokens))
|
|
nil
|
|
(if
|
|
(and (= (nth tokens i) kw) (< (+ i 1) (len tokens)))
|
|
(nth tokens (+ i 1))
|
|
(_find-kw-in-tokens tokens (+ i 1) kw)))))
|
|
(define
|
|
_find-keyword-value
|
|
:effects ()
|
|
(fn
|
|
((content :as string) (kw :as string))
|
|
(_find-kw-in-tokens (split content ".") 0 kw)))
|
|
(define
|
|
_replace-kw-in-tokens
|
|
:effects ()
|
|
(fn
|
|
((tokens :as list)
|
|
(i :as number)
|
|
(kw :as string)
|
|
(value :as string))
|
|
(if
|
|
(>= i (len tokens))
|
|
(list)
|
|
(if
|
|
(and (= (nth tokens i) kw) (< (+ i 1) (len tokens)))
|
|
(append
|
|
(list kw value)
|
|
(_replace-kw-in-tokens tokens (+ i 2) kw value))
|
|
(cons
|
|
(nth tokens i)
|
|
(_replace-kw-in-tokens tokens (+ i 1) kw value))))))
|
|
(define
|
|
_set-keyword-in-content
|
|
:effects ()
|
|
(fn
|
|
((content :as string) (kw :as string) (value :as string))
|
|
(let
|
|
((current (_find-keyword-value content kw)))
|
|
(if
|
|
(nil? current)
|
|
(str content "." kw "." value)
|
|
(join "." (_replace-kw-in-tokens (split content ".") 0 kw value))))))
|
|
(define
|
|
_is-delta-value?
|
|
:effects ()
|
|
(fn
|
|
((s :as string))
|
|
(and
|
|
(not (empty? s))
|
|
(> (len s) 1)
|
|
(or (starts-with? s "+") (starts-with? s "-")))))
|
|
(define
|
|
_apply-delta
|
|
:effects ()
|
|
(fn
|
|
((current-str :as string) (delta-str :as string))
|
|
(let
|
|
((cur (parse-int current-str nil))
|
|
(delta (parse-int delta-str nil)))
|
|
(if (or (nil? cur) (nil? delta)) delta-str (str (+ cur delta))))))
|
|
(define
|
|
_apply-kw-pairs
|
|
:effects ()
|
|
(fn
|
|
((content :as string) (kw-pairs :as list))
|
|
(if
|
|
(empty? kw-pairs)
|
|
content
|
|
(let
|
|
((pair (first kw-pairs))
|
|
(kw (first pair))
|
|
(raw-val (nth pair 1)))
|
|
(let
|
|
((actual-val (if (_is-delta-value? raw-val) (let ((current (_find-keyword-value content kw))) (if (nil? current) raw-val (_apply-delta current raw-val))) raw-val)))
|
|
(_apply-kw-pairs
|
|
(_set-keyword-in-content content kw actual-val)
|
|
(rest kw-pairs)))))))
|
|
(define
|
|
_apply-keywords-to-url
|
|
:effects ()
|
|
(fn
|
|
((url :as string) (kw-pairs :as list))
|
|
(if
|
|
(empty? kw-pairs)
|
|
url
|
|
(let
|
|
((parts (_extract-innermost url)))
|
|
(let
|
|
((new-content (_apply-kw-pairs (get parts "content") kw-pairs)))
|
|
(str (get parts "before") new-content (get parts "suffix")))))))
|
|
(define
|
|
_normalize-relative
|
|
:effects ()
|
|
(fn
|
|
((url :as string))
|
|
(if (starts-with? url "(") url (str "(" url ")"))))
|
|
(define
|
|
resolve-relative-url
|
|
:effects ()
|
|
(fn
|
|
((current :as string) (relative :as string))
|
|
(let
|
|
((canonical (_normalize-relative relative)))
|
|
(let
|
|
((rel-inner (slice canonical 1 (- (len canonical) 1))))
|
|
(let
|
|
((dots (_count-leading-dots rel-inner))
|
|
(body (slice rel-inner (_count-leading-dots rel-inner))))
|
|
(if
|
|
(= dots 0)
|
|
current
|
|
(let
|
|
((parsed (_parse-relative-body body))
|
|
(pos-body (get parsed "positional"))
|
|
(kw-pairs (get parsed "keywords")))
|
|
(let
|
|
((after-nav (if (= dots 1) (if (empty? pos-body) current (let ((stripped (_strip-trailing-close current)) (suffix (slice current (len (_strip-trailing-close current))))) (str stripped "." pos-body suffix))) (let ((base (_pop-sx-url-levels current (- dots 1)))) (if (empty? pos-body) base (if (= base "/") (str "/(" pos-body ")") (let ((stripped (_strip-trailing-close base)) (suffix (slice base (len (_strip-trailing-close base))))) (str stripped ".(" pos-body ")" suffix))))))))
|
|
(_apply-keywords-to-url after-nav kw-pairs)))))))))
|
|
(define
|
|
relative-sx-url?
|
|
:effects ()
|
|
(fn
|
|
((url :as string))
|
|
(or
|
|
(and (starts-with? url "(") (not (starts-with? url "/(")))
|
|
(starts-with? url "."))))
|
|
(define
|
|
_url-special-forms
|
|
:effects ()
|
|
(fn () (list "!source" "!inspect" "!diff" "!search" "!raw" "!json")))
|
|
(define
|
|
url-special-form?
|
|
:effects ()
|
|
(fn
|
|
((name :as string))
|
|
(and (starts-with? name "!") (contains? (_url-special-forms) name))))
|
|
(define
|
|
parse-sx-url
|
|
:effects ()
|
|
(fn
|
|
((url :as string))
|
|
(cond
|
|
(= url "/")
|
|
{:raw url :type "home"}
|
|
(relative-sx-url? url)
|
|
{:raw url :type "relative"}
|
|
(and (starts-with? url "/(!") (ends-with? url ")"))
|
|
(let
|
|
((inner (slice url 2 (- (len url) 1))))
|
|
(let
|
|
((dot-pos (_index-of-safe inner "."))
|
|
(paren-pos (_index-of-safe inner "(")))
|
|
(let
|
|
((end-pos (cond (and (nil? dot-pos) (nil? paren-pos)) (len inner) (nil? dot-pos) paren-pos (nil? paren-pos) dot-pos :else (min dot-pos paren-pos))))
|
|
(let
|
|
((form-name (slice inner 0 end-pos))
|
|
(rest-part (slice inner end-pos)))
|
|
(let
|
|
((inner-expr (if (starts-with? rest-part ".") (slice rest-part 1) rest-part)))
|
|
{:raw url :type "special-form" :inner inner-expr :form form-name})))))
|
|
(and (starts-with? url "/(~") (ends-with? url ")"))
|
|
(let ((name (slice url 2 (- (len url) 1)))) {:raw url :type "direct-component" :name name})
|
|
(and (starts-with? url "/(") (ends-with? url ")"))
|
|
{:raw url :type "absolute"}
|
|
:else {:raw url :type "path"})))
|
|
(define
|
|
url-special-form-name
|
|
:effects ()
|
|
(fn
|
|
((url :as string))
|
|
(let
|
|
((parsed (parse-sx-url url)))
|
|
(if
|
|
(= (get parsed "type") "special-form")
|
|
(get parsed "form")
|
|
nil))))
|
|
(define
|
|
url-special-form-inner
|
|
:effects ()
|
|
(fn
|
|
((url :as string))
|
|
(let
|
|
((parsed (parse-sx-url url)))
|
|
(if
|
|
(= (get parsed "type") "special-form")
|
|
(get parsed "inner")
|
|
nil))))
|
|
(define
|
|
url-to-expr
|
|
:effects ()
|
|
(fn
|
|
((url-path :as string))
|
|
(if
|
|
(or (= url-path "/") (empty? url-path))
|
|
(list)
|
|
(let
|
|
((trimmed (if (starts-with? url-path "/") (slice url-path 1) url-path)))
|
|
(let
|
|
((sx-source (replace trimmed "." " ")))
|
|
(let
|
|
((exprs (sx-parse sx-source)))
|
|
(if (empty? exprs) (list) (first exprs))))))))
|
|
(define
|
|
auto-quote-unknowns
|
|
:effects ()
|
|
(fn
|
|
((expr :as list) (env :as dict))
|
|
(if
|
|
(not (list? expr))
|
|
expr
|
|
(if
|
|
(empty? expr)
|
|
expr
|
|
(cons
|
|
(first expr)
|
|
(map
|
|
(fn
|
|
(child)
|
|
(cond
|
|
(list? child)
|
|
(auto-quote-unknowns child env)
|
|
(= (type-of child) "symbol")
|
|
(let
|
|
((name (symbol-name child)))
|
|
(if
|
|
(or
|
|
(env-has? env name)
|
|
(starts-with? name ":")
|
|
(starts-with? name "~")
|
|
(starts-with? name "!"))
|
|
child
|
|
name))
|
|
:else child))
|
|
(rest expr)))))))
|
|
(define
|
|
prepare-url-expr
|
|
:effects ()
|
|
(fn
|
|
((url-path :as string) (env :as dict))
|
|
(let
|
|
((expr (url-to-expr url-path)))
|
|
(if (empty? expr) expr (auto-quote-unknowns expr env))))))) ;; end define-library
|
|
|
|
;; Re-export to global namespace for backward compatibility
|
|
(import (web router))
|