;; ========================================================================== ;; 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))