giles
5f06e2e2cc
Add url-to-expr, auto-quote-unknowns, prepare-url-expr to router.sx — the canonical URL-to-expression pipeline. Dots→spaces, parse, then auto-quote unknown symbols as strings (slugs). The same spec serves both server (Python) and client (JS) route handling. - router.sx: three new pure functions for URL evaluation - bootstrap_py.py: auto-include router module with html adapter - platform_js.py: export urlToExpr/autoQuoteUnknowns/prepareUrlExpr - sx_router.py: replace hand-written auto_quote_slugs with bootstrapped prepare_url_expr — delete ~50 lines of hardcoded function name sets - Rebootstrap sx_ref.py (4331 lines) and sx-browser.js Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
681 lines
28 KiB
Plaintext
681 lines
28 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 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 "/"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 2. Parse Flask-style route pattern into segment descriptors
|
|
;; --------------------------------------------------------------------------
|
|
;; "/docs/<slug>" → ({"type" "literal" "value" "docs"}
|
|
;; {"type" "param" "value" "slug"})
|
|
|
|
(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))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 3. Match path segments against parsed pattern
|
|
;; --------------------------------------------------------------------------
|
|
;; Returns params dict if match, nil if no match.
|
|
|
|
(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)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 4. Public API: match a URL path against a pattern string
|
|
;; --------------------------------------------------------------------------
|
|
;; Returns params dict (may be empty for exact matches) or 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))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 5. Search a list of route entries for first match
|
|
;; --------------------------------------------------------------------------
|
|
;; Each entry: {"pattern" "/docs/<slug>" "parsed" [...] "name" "docs-page" ...}
|
|
;; Returns matching entry with "params" added, or nil.
|
|
|
|
(define find-matching-route :effects []
|
|
(fn ((path :as string) (routes :as list))
|
|
;; If path is an SX expression URL, convert to old-style for matching.
|
|
(let ((match-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))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 6. SX expression URL → old-style path conversion
|
|
;; --------------------------------------------------------------------------
|
|
;; Converts /(language.(doc.introduction)) → /language/docs/introduction
|
|
;; so client-side routing can match SX URLs against Flask-style patterns.
|
|
|
|
(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))
|
|
;; Convert an SX expression URL to an old-style slash path.
|
|
;; "/(language.(doc.introduction))" → "/language/docs/introduction"
|
|
;; Returns nil for non-SX URLs (those not starting with "/(" ).
|
|
(if (not (and (starts-with? url "/(") (ends-with? url ")")))
|
|
nil
|
|
(let ((inner (slice url 2 (- (len url) 1))))
|
|
;; "language.(doc.introduction)" → dots to slashes, strip parens
|
|
(let ((s (replace (replace (replace inner "." "/") "(" "") ")" "")))
|
|
;; "language/doc/introduction" → split, map names, rejoin
|
|
(let ((segs (filter (fn (s) (not (empty? s))) (split s "/"))))
|
|
(str "/" (join "/" (map _fn-to-segment segs)))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 7. Relative SX URL resolution
|
|
;; --------------------------------------------------------------------------
|
|
;; Resolves relative SX URLs against the current absolute URL.
|
|
;; This is a macro in the deepest sense: SX transforming SX into SX.
|
|
;; The URL is code. Relative resolution is code transformation.
|
|
;;
|
|
;; Relative URLs start with ( or . :
|
|
;; (.slug) → append slug as argument to innermost call
|
|
;; (..section) → up 1: replace innermost with new nested call
|
|
;; (...section) → up 2: replace 2 innermost levels
|
|
;;
|
|
;; Bare-dot shorthand (parens optional):
|
|
;; .slug → same as (.slug)
|
|
;; .. → same as (..) — go up one level
|
|
;; ... → same as (...) — go up two levels
|
|
;; .:page.4 → same as (.:page.4) — set keyword
|
|
;;
|
|
;; Dot count semantics (parallels filesystem . and ..):
|
|
;; 1 dot = current level (append argument / modify keyword)
|
|
;; 2 dots = up 1 level (sibling call)
|
|
;; 3 dots = up 2 levels
|
|
;; N dots = up N-1 levels
|
|
;;
|
|
;; Keyword operations (set, delta):
|
|
;; (.:page.4) → set :page to 4 at current level
|
|
;; (.:page.+1) → increment :page by 1 (delta)
|
|
;; (.:page.-1) → decrement :page by 1 (delta)
|
|
;; (.slug.:page.1) → append slug AND set :page=1
|
|
;;
|
|
;; Examples (current = "/(geography.(hypermedia.(example)))"):
|
|
;; (.progress-bar) → /(geography.(hypermedia.(example.progress-bar)))
|
|
;; (..reactive.demo) → /(geography.(hypermedia.(reactive.demo)))
|
|
;; (...marshes) → /(geography.(marshes))
|
|
;; (..) → /(geography.(hypermedia))
|
|
;; (...) → /(geography)
|
|
;;
|
|
;; Keyword examples (current = "/(language.(spec.(explore.signals.:page.3)))"):
|
|
;; (.:page.4) → /(language.(spec.(explore.signals.:page.4)))
|
|
;; (.:page.+1) → /(language.(spec.(explore.signals.:page.4)))
|
|
;; (.:page.-1) → /(language.(spec.(explore.signals.:page.2)))
|
|
;; (..eval) → /(language.(spec.(eval)))
|
|
;; (..eval.:page.1) → /(language.(spec.(eval.:page.1)))
|
|
|
|
(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))
|
|
;; Strip trailing ) characters: "/(a.(b.(c" from "/(a.(b.(c)))"
|
|
(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))
|
|
;; Wrapper around index-of that normalizes -1 to nil.
|
|
;; (index-of returns -1 on some platforms, nil on others.)
|
|
(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))
|
|
;; Find the last occurrence of needle in s. Returns nil if not found.
|
|
(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))
|
|
;; Remove the innermost nesting level from an absolute SX URL.
|
|
;; "/(a.(b.(c)))" → "/(a.(b))"
|
|
;; "/(a.(b))" → "/(a)"
|
|
;; "/(a)" → "/"
|
|
(let ((stripped (_strip-trailing-close url))
|
|
(close-count (- (len url) (len (_strip-trailing-close url)))))
|
|
(if (<= close-count 1)
|
|
"/" ;; at root, popping goes to bare root
|
|
(let ((last-dp (_last-index-of stripped ".(")))
|
|
(if (nil? last-dp)
|
|
"/" ;; single-level URL, pop to root
|
|
;; Remove from .( to end of stripped, drop one closing paren
|
|
(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)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 8. Relative URL body parsing — positional vs keyword tokens
|
|
;; --------------------------------------------------------------------------
|
|
;; Body "slug.:page.4" → positional "slug", keywords ((:page 4))
|
|
;; Body ":page.+1" → positional "", keywords ((:page +1))
|
|
|
|
(define _split-pos-kw :effects []
|
|
(fn ((tokens :as list) (i :as number) (pos :as list) (kw :as list))
|
|
;; Walk tokens: non-: tokens are positional, : tokens consume next as value
|
|
(if (>= i (len tokens))
|
|
{"positional" (join "." pos) "keywords" kw}
|
|
(let ((tok (nth tokens i)))
|
|
(if (starts-with? tok ":")
|
|
;; Keyword: take this + next token as a pair
|
|
(let ((val (if (< (+ i 1) (len tokens))
|
|
(nth tokens (+ i 1))
|
|
"")))
|
|
(_split-pos-kw tokens (+ i 2) pos
|
|
(append kw (list (list tok val)))))
|
|
;; Positional token
|
|
(_split-pos-kw tokens (+ i 1)
|
|
(append pos (list tok))
|
|
kw))))))
|
|
|
|
(define _parse-relative-body :effects []
|
|
(fn ((body :as string))
|
|
;; Returns {"positional" <string> "keywords" <list of (kw val) pairs>}
|
|
(if (empty? body)
|
|
{"positional" "" "keywords" (list)}
|
|
(_split-pos-kw (split body ".") 0 (list) (list)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 9. Keyword operations on URL expressions
|
|
;; --------------------------------------------------------------------------
|
|
;; Extract, find, and modify keyword arguments in the innermost expression.
|
|
|
|
(define _extract-innermost :effects []
|
|
(fn ((url :as string))
|
|
;; Returns {"before" ... "content" ... "suffix" ...}
|
|
;; where before + content + suffix = url
|
|
;; content = the innermost expression's dot-separated tokens
|
|
(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)
|
|
;; Single-level: /(content)
|
|
{"before" "/("
|
|
"content" (slice stripped 2)
|
|
"suffix" suffix}
|
|
;; Multi-level: .../.(content)...)
|
|
{"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))
|
|
;; Find value of keyword kw in token list. Returns nil if not found.
|
|
(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 keyword's value in dot-separated content string.
|
|
;; "explore.signals.:page.3" ":page" → "3"
|
|
(_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))
|
|
;; Replace keyword's value in token list. Returns new token list.
|
|
(if (>= i (len tokens))
|
|
(list)
|
|
(if (and (= (nth tokens i) kw)
|
|
(< (+ i 1) (len tokens)))
|
|
;; Found — keep keyword, replace value, concat rest
|
|
(append (list kw value)
|
|
(_replace-kw-in-tokens tokens (+ i 2) kw value))
|
|
;; Not this keyword — keep token, continue
|
|
(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))
|
|
;; Set or replace keyword value in dot-separated content.
|
|
;; "a.b.:page.3" ":page" "4" → "a.b.:page.4"
|
|
;; "a.b" ":page" "1" → "a.b.:page.1"
|
|
(let ((current (_find-keyword-value content kw)))
|
|
(if (nil? current)
|
|
;; Not found — append
|
|
(str content "." kw "." value)
|
|
;; Found — replace
|
|
(join "." (_replace-kw-in-tokens (split content ".") 0 kw value))))))
|
|
|
|
(define _is-delta-value? :effects []
|
|
(fn ((s :as string))
|
|
;; "+1", "-2", "+10" are deltas. "-" alone is not.
|
|
(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))
|
|
;; Apply numeric delta to current value string.
|
|
;; "3" "+1" → "4", "3" "-1" → "2"
|
|
(let ((cur (parse-int current-str nil))
|
|
(delta (parse-int delta-str nil)))
|
|
(if (or (nil? cur) (nil? delta))
|
|
delta-str ;; fallback: use delta as literal value
|
|
(str (+ cur delta))))))
|
|
|
|
(define _apply-kw-pairs :effects []
|
|
(fn ((content :as string) (kw-pairs :as list))
|
|
;; Apply keyword modifications to content, one at a time.
|
|
(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 ;; no current value, treat delta as literal
|
|
(_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))
|
|
;; Apply keyword modifications to the innermost expression of a URL.
|
|
(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")))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 10. Public API: resolve-relative-url (structural + keywords)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define _normalize-relative :effects []
|
|
(fn ((url :as string))
|
|
;; Normalize bare-dot shorthand to paren form.
|
|
;; ".." → "(..)"
|
|
;; ".slug" → "(.slug)"
|
|
;; ".:page.4" → "(.:page.4)"
|
|
;; "(.slug)" → "(.slug)" (already canonical)
|
|
(if (starts-with? url "(")
|
|
url
|
|
(str "(" url ")"))))
|
|
|
|
(define resolve-relative-url :effects []
|
|
(fn ((current :as string) (relative :as string))
|
|
;; current: absolute SX URL "/(geography.(hypermedia.(example)))"
|
|
;; relative: relative SX URL "(.progress-bar)" or ".." or ".:page.+1"
|
|
;; Returns: absolute SX URL
|
|
(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 ;; no dots — not a relative URL
|
|
;; Parse body into positional part + keyword pairs
|
|
(let ((parsed (_parse-relative-body body))
|
|
(pos-body (get parsed "positional"))
|
|
(kw-pairs (get parsed "keywords")))
|
|
;; Step 1: structural navigation
|
|
(let ((after-nav
|
|
(if (= dots 1)
|
|
;; One dot = current level
|
|
(if (empty? pos-body)
|
|
current ;; no positional → stay here (keyword-only)
|
|
;; Append positional part at current level
|
|
(let ((stripped (_strip-trailing-close current))
|
|
(suffix (slice current (len (_strip-trailing-close current)))))
|
|
(str stripped "." pos-body suffix)))
|
|
;; Two+ dots = pop (dots-1) levels
|
|
(let ((base (_pop-sx-url-levels current (- dots 1))))
|
|
(if (empty? pos-body)
|
|
base ;; no positional → just pop (cd ..)
|
|
(if (= base "/")
|
|
(str "/(" pos-body ")")
|
|
(let ((stripped (_strip-trailing-close base))
|
|
(suffix (slice base (len (_strip-trailing-close base)))))
|
|
(str stripped ".(" pos-body ")" suffix))))))))
|
|
;; Step 2: apply keyword modifications
|
|
(_apply-keywords-to-url after-nav kw-pairs)))))))))
|
|
|
|
;; Check if a URL is relative (starts with ( but not /( , or starts with .)
|
|
(define relative-sx-url? :effects []
|
|
(fn ((url :as string))
|
|
(or (and (starts-with? url "(")
|
|
(not (starts-with? url "/(")))
|
|
(starts-with? url "."))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 11. URL special forms (! prefix)
|
|
;; --------------------------------------------------------------------------
|
|
;; Special forms are meta-operations on URL expressions.
|
|
;; Distinguished by `!` prefix to avoid name collisions with sections/pages.
|
|
;;
|
|
;; Known forms:
|
|
;; !source — show defcomp source code
|
|
;; !inspect — deps, CSS footprint, render plan, IO
|
|
;; !diff — side-by-side comparison of two expressions
|
|
;; !search — grep within a page/spec
|
|
;; !raw — skip ~sx-doc wrapping, return raw content
|
|
;; !json — return content as JSON data
|
|
;;
|
|
;; URL examples:
|
|
;; /(!source.(~essay-sx-sucks))
|
|
;; /(!inspect.(language.(doc.primitives)))
|
|
;; /(!diff.(language.(spec.signals)).(language.(spec.eval)))
|
|
;; /(!search."define".:in.(language.(spec.signals)))
|
|
;; /(!raw.(~some-component))
|
|
;; /(!json.(language.(doc.primitives)))
|
|
|
|
(define _url-special-forms :effects []
|
|
(fn ()
|
|
;; Returns the set of known URL special form names.
|
|
(list "!source" "!inspect" "!diff" "!search" "!raw" "!json")))
|
|
|
|
(define url-special-form? :effects []
|
|
(fn ((name :as string))
|
|
;; Check if a name is a URL special form (starts with ! and is known).
|
|
(and (starts-with? name "!")
|
|
(contains? (_url-special-forms) name))))
|
|
|
|
(define parse-sx-url :effects []
|
|
(fn ((url :as string))
|
|
;; Parse an SX URL into a structured descriptor.
|
|
;; Returns a dict with:
|
|
;; "type" — "home" | "absolute" | "relative" | "special-form" | "direct-component"
|
|
;; "form" — special form name (for special-form type), e.g. "!source"
|
|
;; "inner" — inner URL expression string (without the special form wrapper)
|
|
;; "raw" — original URL string
|
|
;;
|
|
;; Examples:
|
|
;; "/" → {"type" "home" "raw" "/"}
|
|
;; "/(language.(doc.intro))" → {"type" "absolute" "raw" ...}
|
|
;; "(.slug)" → {"type" "relative" "raw" ...}
|
|
;; "..slug" → {"type" "relative" "raw" ...}
|
|
;; "/(!source.(~essay))" → {"type" "special-form" "form" "!source" "inner" "(~essay)" "raw" ...}
|
|
;; "/(~essay-sx-sucks)" → {"type" "direct-component" "name" "~essay-sx-sucks" "raw" ...}
|
|
(cond
|
|
(= url "/")
|
|
{"type" "home" "raw" url}
|
|
(relative-sx-url? url)
|
|
{"type" "relative" "raw" url}
|
|
(and (starts-with? url "/(!")
|
|
(ends-with? url ")"))
|
|
;; Special form: /(!source.(~essay)) or /(!diff.a.b)
|
|
;; Extract the form name (first dot-separated token after /()
|
|
(let ((inner (slice url 2 (- (len url) 1))))
|
|
;; inner = "!source.(~essay)" or "!diff.(a).(b)"
|
|
(let ((dot-pos (_index-of-safe inner "."))
|
|
(paren-pos (_index-of-safe inner "(")))
|
|
;; Form name ends at first . or ( (whichever comes first)
|
|
(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)))
|
|
;; rest-part starts with "." → strip leading dot
|
|
(let ((inner-expr (if (starts-with? rest-part ".")
|
|
(slice rest-part 1)
|
|
rest-part)))
|
|
{"type" "special-form"
|
|
"form" form-name
|
|
"inner" inner-expr
|
|
"raw" url})))))
|
|
(and (starts-with? url "/(~")
|
|
(ends-with? url ")"))
|
|
;; Direct component: /(~essay-sx-sucks)
|
|
(let ((name (slice url 2 (- (len url) 1))))
|
|
{"type" "direct-component" "name" name "raw" url})
|
|
(and (starts-with? url "/(")
|
|
(ends-with? url ")"))
|
|
{"type" "absolute" "raw" url}
|
|
:else
|
|
{"type" "path" "raw" url})))
|
|
|
|
(define url-special-form-name :effects []
|
|
(fn ((url :as string))
|
|
;; Extract the special form name from a URL, or nil if not a special form.
|
|
;; "/(!source.(~essay))" → "!source"
|
|
;; "/(language.(doc))" → nil
|
|
(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))
|
|
;; Extract the inner expression from a special form URL, or nil.
|
|
;; "/(!source.(~essay))" → "(~essay)"
|
|
;; "/(!diff.(a).(b))" → "(a).(b)"
|
|
(let ((parsed (parse-sx-url url)))
|
|
(if (= (get parsed "type") "special-form")
|
|
(get parsed "inner")
|
|
nil))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 12. URL expression evaluation
|
|
;; --------------------------------------------------------------------------
|
|
;; A URL is an expression. The system is the environment.
|
|
;; eval(url, env) — that's it.
|
|
;;
|
|
;; The only URL-specific pre-processing:
|
|
;; 1. Surface syntax → AST (dots to spaces, parse as SX)
|
|
;; 2. Auto-quote unknowns (symbols not in env become strings)
|
|
;;
|
|
;; After that, it's standard eval. The host wires these into its route
|
|
;; handlers (Python catch-all, JS client-side navigation). The same
|
|
;; functions serve both.
|
|
|
|
(define url-to-expr :effects []
|
|
(fn ((url-path :as string))
|
|
;; Convert a URL path to an SX expression (AST).
|
|
;;
|
|
;; "/sx/(language.(doc.introduction))" → (language (doc introduction))
|
|
;; "/(language.(doc.introduction))" → (language (doc introduction))
|
|
;; "/" → (list) ; empty — home
|
|
;;
|
|
;; Steps:
|
|
;; 1. Strip URL prefix ("/sx/" or "/") — host passes the path after prefix
|
|
;; 2. Dots → spaces (URL-safe whitespace encoding)
|
|
;; 3. Parse as SX expression
|
|
;;
|
|
;; The caller is responsible for stripping any app-level prefix.
|
|
;; This function receives the raw expression portion: "(language.(doc.intro))"
|
|
;; or "/" for home.
|
|
(if (or (= url-path "/") (empty? url-path))
|
|
(list)
|
|
(let ((trimmed (if (starts-with? url-path "/")
|
|
(slice url-path 1)
|
|
url-path)))
|
|
;; Dots → spaces
|
|
(let ((sx-source (replace trimmed "." " ")))
|
|
;; Parse — returns list of expressions, take the first
|
|
(let ((exprs (sx-parse sx-source)))
|
|
(if (empty? exprs)
|
|
(list)
|
|
(first exprs))))))))
|
|
|
|
|
|
(define auto-quote-unknowns :effects []
|
|
(fn ((expr :as list) (env :as dict))
|
|
;; Walk an AST and replace symbols not in env with their name as a string.
|
|
;; This makes URL slugs work without quoting:
|
|
;; (language (doc introduction)) ; introduction is not a function
|
|
;; → (language (doc "introduction"))
|
|
;;
|
|
;; Rules:
|
|
;; - List head (call position) stays as-is — it's a function name
|
|
;; - Tail symbols: if in env, keep as symbol; otherwise, string
|
|
;; - Keywords, strings, numbers, nested lists: pass through
|
|
;; - Non-list expressions: pass through unchanged
|
|
(if (not (list? expr))
|
|
expr
|
|
(if (empty? expr)
|
|
expr
|
|
;; Head stays as symbol (function position), quote the rest
|
|
(cons (first expr)
|
|
(map (fn (child)
|
|
(cond
|
|
;; Nested list — recurse
|
|
(list? child)
|
|
(auto-quote-unknowns child env)
|
|
;; Symbol — check env
|
|
(= (type-of child) "symbol")
|
|
(let ((name (symbol-name child)))
|
|
(if (or (env-has? env name)
|
|
;; Keep keywords, component refs, special forms
|
|
(starts-with? name ":")
|
|
(starts-with? name "~")
|
|
(starts-with? name "!"))
|
|
child
|
|
name)) ;; unknown → string
|
|
;; Everything else passes through
|
|
:else child))
|
|
(rest expr)))))))
|
|
|
|
|
|
(define prepare-url-expr :effects []
|
|
(fn ((url-path :as string) (env :as dict))
|
|
;; Full pipeline: URL path → ready-to-eval AST.
|
|
;;
|
|
;; "(language.(doc.introduction))" + env
|
|
;; → (language (doc "introduction"))
|
|
;;
|
|
;; The result can be fed directly to eval:
|
|
;; (eval (prepare-url-expr path env) env)
|
|
(let ((expr (url-to-expr url-path)))
|
|
(if (empty? expr)
|
|
expr
|
|
(auto-quote-unknowns expr env)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Platform interface
|
|
;; --------------------------------------------------------------------------
|
|
;; Pure primitives used:
|
|
;; split, slice, starts-with?, ends-with?, len, empty?, replace,
|
|
;; map, filter, for-each, for-each-indexed, nth, get, dict-set!, merge,
|
|
;; list, nil?, not, =, case, join, str, index-of, and, or, cons,
|
|
;; first, rest, append, parse-int, contains?, min, cond,
|
|
;; symbol?, symbol-name, list?, env-has?, type-of
|
|
;;
|
|
;; From parser.sx: sx-parse, sx-serialize
|
|
;; --------------------------------------------------------------------------
|