Files
rose-ash/sx/sx/page-functions.sx
giles ac65666f6f Fix SX client navigation: path-derived names, provide clash, component expansion
- inject_path_name: strip _islands/ convention dirs from path-derived names
- page-functions.sx: fix geography (→ ~geography) and isomorphism (→ ~etc/plan/isomorphic)
- request-handler.sx: rewrite sx-eval-page to call page functions explicitly
  via env-get+apply, avoiding provide special form intercepting (provide) calls
- sx_server.ml: set expand-components? on AJAX aser paths so server-side
  components expand for the browser (islands stay unexpanded for hydration)
- Rename 19 component references in geography/spreads, geography/provide,
  geography/scopes to use path-qualified names matching inject_path_name output

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-18 10:19:00 +00:00

718 lines
24 KiB
Plaintext

(define
slug->component
(fn
(slug prefix infix suffix)
(if
infix
(make-symbol (str prefix slug infix slug suffix))
(make-symbol (str prefix slug suffix)))))
(define
make-page-fn
(fn
(default-name prefix infix suffix)
(fn
(slug)
(if
(nil? slug)
(list (make-symbol default-name))
(list (slug->component slug prefix infix suffix))))))
(define home (fn (content) (if (nil? content) (quote (~home)) content)))
(define language (fn (content) (if (nil? content) (quote (<>)) content)))
(define
geography
(fn (content) (if (nil? content) (quote (~geography)) content)))
(define
applications
(fn (content) (if (nil? content) (quote (<>)) content)))
(define etc (fn (content) (if (nil? content) (quote (<>)) content)))
(define hypermedia (fn (content) (or content "")))
(define
reactive
(fn (content) (if (nil? content) (quote (~geography/reactive)) content)))
(define
examples
(make-page-fn
"~geography/reactive/examples"
"~geography/reactive/examples/"
nil
""))
(define
cek
(fn
(slug)
(if
(nil? slug)
(quote (~geography/cek))
(case
slug
"demo"
(quote (~geography/cek/demo))
"freeze"
(quote (~geography/cek/freeze))
"content"
(quote (~geography/cek/content))
:else (quote (~geography/cek))))))
(define
provide
(fn (content) (if (nil? content) (quote (~geography/provide)) content)))
(define
scopes
(fn (content) (if (nil? content) (quote (~geography/scopes)) content)))
(define
spreads
(fn (content) (if (nil? content) (quote (~geography/spreads)) content)))
(define
marshes
(fn
(slug)
(if
(nil? slug)
(quote (~geography/marshes))
(case
slug
"hypermedia-feeds"
(quote (~geography/marshes/hypermedia-feeds))
"server-signals"
(quote (~geography/marshes/server-signals))
"on-settle"
(quote (~geography/marshes/on-settle))
"signal-triggers"
(quote (~geography/marshes/signal-triggers))
"view-transform"
(quote (~geography/marshes/view-transform))
:else (quote (~geography/marshes))))))
(define
isomorphism
(fn
(slug)
(if
(nil? slug)
(quote (~etc/plan/isomorphic))
(case
slug
"bundle-analyzer"
(let
((data (helper "bundle-analyzer-data")))
(quasiquote
(~geography/isomorphism/bundle-analyzer
:pages (unquote (get data "pages"))
:total-components (unquote (get data "total-components"))
:total-macros (unquote (get data "total-macros"))
:pure-count (unquote (get data "pure-count"))
:io-count (unquote (get data "io-count")))))
"routing-analyzer"
(let
((data (helper "routing-analyzer-data")))
(quasiquote
(~geography/isomorphism/routing-analyzer
:pages (unquote (get data "pages"))
:total-pages (unquote (get data "total-pages"))
:client-count (unquote (get data "client-count"))
:server-count (unquote (get data "server-count"))
:registry-sample (unquote (get data "registry-sample")))))
"data-test"
(let
((data (helper "data-test-data")))
(quasiquote
(~geography/isomorphism/data-test
:server-time (unquote (get data "server-time"))
:items (unquote (get data "items"))
:phase (unquote (get data "phase"))
:transport (unquote (get data "transport")))))
"async-io"
(quote (~geography/isomorphism/async-io))
"affinity"
(let
((data (helper "affinity-demo-data")))
(quasiquote
(~geography/isomorphism/affinity
:components (unquote (get data "components"))
:page-plans (unquote (get data "page-plans")))))
"optimistic"
(let
((data (helper "optimistic-demo-data")))
(quasiquote
(~geography/isomorphism/optimistic
:items (unquote (get data "items"))
:server-time (unquote (get data "server-time")))))
"offline"
(let
((data (helper "offline-demo-data")))
(quasiquote
(~geography/isomorphism/offline
:notes (unquote (get data "notes"))
:server-time (unquote (get data "server-time")))))
:else (quote (~geography/isomorphism))))))
(define
doc
(fn
(slug)
(if
(nil? slug)
(quote (~language/doc/introduction))
(case
slug
"introduction"
(quote (~language/doc/introduction))
"getting-started"
(quote (~language/doc/getting-started))
"components"
(quote (~language/doc/components))
"evaluator"
(quote (~language/doc/evaluator))
"primitives"
(let
((data (helper "primitives-data")))
(quasiquote
(~language/doc/primitives
:prims (~language/doc/_shared/primitives-tables
:primitives (unquote data)))))
"special-forms"
(let
((data (helper "special-forms-data")))
(quasiquote
(~language/doc/special-forms
:forms (~language/doc/_shared/special-forms-tables
:forms (unquote data)))))
"server-rendering"
(quote (~language/doc/server-rendering))
:else (quote (~language/doc/introduction))))))
(define
spec
(fn
(slug)
(cond
(nil? slug)
(quote (~language/spec))
(not (= (type-of slug) "string"))
slug
:else (case
slug
"core"
(let
((files (make-spec-files core-spec-items)))
(quasiquote
(~language/spec/_shared/overview-content
:spec-title "Core Language"
:spec-files (unquote files))))
"adapters"
(let
((files (make-spec-files adapter-spec-items)))
(quasiquote
(~language/spec/_shared/overview-content
:spec-title "Adapters"
:spec-files (unquote files))))
"browser"
(let
((files (make-spec-files browser-spec-items)))
(quasiquote
(~language/spec/_shared/overview-content
:spec-title "Browser Runtime"
:spec-files (unquote files))))
"reactive"
(let
((files (make-spec-files reactive-spec-items)))
(quasiquote
(~language/spec/_shared/overview-content
:spec-title "Reactive System"
:spec-files (unquote files))))
"host"
(let
((files (make-spec-files host-spec-items)))
(quasiquote
(~language/spec/_shared/overview-content
:spec-title "Host Interface"
:spec-files (unquote files))))
"extensions"
(let
((files (make-spec-files extension-spec-items)))
(quasiquote
(~language/spec/_shared/overview-content
:spec-title "Extensions"
:spec-files (unquote files))))
:else (let
((found-spec (find-spec slug)))
(if
found-spec
(let
((src (helper "read-spec-file" (get found-spec "filename"))))
(quasiquote
(~language/spec/_shared/detail-content
:spec-title (unquote (get found-spec "title"))
:spec-desc (unquote (get found-spec "desc"))
:spec-filename (unquote (get found-spec "filename"))
:spec-source (unquote src)
:spec-prose (unquote (get found-spec "prose")))))
(quasiquote
(~language/spec/_shared/not-found :slug (unquote slug)))))))))
(define
explore
(fn
(slug defname)
(if
(nil? slug)
(quote (~specs/architecture-content))
(let
((found-spec (find-spec slug))
(filename
(if found-spec (get found-spec "filename") (str slug ".sx")))
(title (if found-spec (get found-spec "title") slug))
(desc (if found-spec (get found-spec "desc") "")))
(if
defname
(let
((d (spec-explore-define filename defname)))
(if
d
(quasiquote
(~specs-explorer/spec-explorer-define-detail
:d (unquote d)
:filename (unquote filename)))
(quasiquote
(~specs/not-found :slug (unquote (str slug "." defname))))))
(let
((data (spec-explore filename title desc)))
(if
data
(quasiquote
(~specs-explorer/spec-explorer-content :data (unquote data)))
(quasiquote (~specs/not-found :slug (unquote slug))))))))))
(define
make-spec-files
(fn
(items)
(map
(fn
(item)
(dict
:title (get item "title")
:desc (get item "desc")
:prose (get item "prose")
:filename (get item "filename")
:href (str "/sx/(language.(spec." (get item "slug") "))")
:source (helper "read-spec-file" (get item "filename"))))
items)))
(define
bootstrapper
(fn
(slug)
(if
(nil? slug)
(quote (~language/bootstrapper))
(let
((data (helper "bootstrapper-data" slug)))
(if
(get data "bootstrapper-not-found")
(quasiquote
(~language/bootstrapper/_shared/not-found :slug (unquote slug)))
(case
slug
"self-hosting"
(quasiquote
(~language/bootstrapper/self-hosting
:py-sx-source (unquote (get data "py-sx-source"))
:g0-output (unquote (get data "g0-output"))
:g1-output (unquote (get data "g1-output"))
:defines-matched (unquote (get data "defines-matched"))
:defines-total (unquote (get data "defines-total"))
:g0-lines (unquote (get data "g0-lines"))
:g0-bytes (unquote (get data "g0-bytes"))
:verification-status (unquote (get data "verification-status"))))
"self-hosting-js"
(quasiquote
(~language/bootstrapper/self-hosting-js
:js-sx-source (unquote (get data "js-sx-source"))
:defines-matched (unquote (get data "defines-matched"))
:defines-total (unquote (get data "defines-total"))
:js-sx-lines (unquote (get data "js-sx-lines"))
:verification-status (unquote (get data "verification-status"))))
"python"
(quasiquote
(~language/bootstrapper/python
:bootstrapper-source (unquote (get data "bootstrapper-source"))
:bootstrapped-output (unquote (get data "bootstrapped-output"))))
"page-helpers"
(let
((ph-data (helper "page-helpers-demo-data")))
(quasiquote
(~language/bootstrapper/page-helpers
:sf-categories (unquote (get ph-data "sf-categories"))
:sf-total (unquote (get ph-data "sf-total"))
:sf-ms (unquote (get ph-data "sf-ms"))
:ref-sample (unquote (get ph-data "ref-sample"))
:ref-ms (unquote (get ph-data "ref-ms"))
:attr-result (unquote (get ph-data "attr-result"))
:attr-ms (unquote (get ph-data "attr-ms"))
:comp-source (unquote (get ph-data "comp-source"))
:comp-ms (unquote (get ph-data "comp-ms"))
:routing-result (unquote (get ph-data "routing-result"))
:routing-ms (unquote (get ph-data "routing-ms"))
:server-total-ms (unquote (get ph-data "server-total-ms"))
:sf-source (unquote (get ph-data "sf-source"))
:attr-detail (unquote (get ph-data "attr-detail"))
:req-attrs (unquote (get ph-data "req-attrs"))
:attr-keys (unquote (get ph-data "attr-keys")))))
:else (quasiquote
(~language/bootstrapper/javascript
:bootstrapper-source (unquote (get data "bootstrapper-source"))
:bootstrapped-output (unquote (get data "bootstrapped-output"))))))))))
(define
test
(fn
(slug)
(if
(nil? slug)
(let
((data (perform (list (quote io-test-data)))))
(quasiquote
(~language/test
:server-results (unquote (get data "server-results"))
:framework-source (unquote (get data "framework-source"))
:eval-source (unquote (get data "eval-source"))
:parser-source (unquote (get data "parser-source"))
:router-source (unquote (get data "router-source"))
:render-source (unquote (get data "render-source"))
:deps-source (unquote (get data "deps-source"))
:engine-source (unquote (get data "engine-source")))))
(if
(not (string? slug))
(quote (~applications/htmx/runner))
(case
slug
"runners"
(quote (~language/test/runners))
"applications"
(quote (~applications/htmx/runner))
:else (let
((data (perform (list (quote io-test-data) slug))))
(case
slug
"eval"
(quasiquote
(~language/test/_shared/spec-content
:spec-name "eval"
:spec-title "Evaluator Tests"
:spec-desc "81 tests covering the core evaluator."
:spec-source (unquote (get data "spec-source"))
:framework-source (unquote (get data "framework-source"))
:server-results (unquote (get data "server-results"))))
"parser"
(quasiquote
(~language/test/_shared/spec-content
:spec-name "parser"
:spec-title "Parser Tests"
:spec-desc "39 tests covering tokenization and parsing."
:spec-source (unquote (get data "spec-source"))
:framework-source (unquote (get data "framework-source"))
:server-results (unquote (get data "server-results"))))
"router"
(quasiquote
(~language/test/_shared/spec-content
:spec-name "router"
:spec-title "Router Tests"
:spec-desc "18 tests covering client-side route matching."
:spec-source (unquote (get data "spec-source"))
:framework-source (unquote (get data "framework-source"))
:server-results (unquote (get data "server-results"))))
"render"
(quasiquote
(~language/test/_shared/spec-content
:spec-name "render"
:spec-title "Renderer Tests"
:spec-desc "23 tests covering HTML rendering."
:spec-source (unquote (get data "spec-source"))
:framework-source (unquote (get data "framework-source"))
:server-results (unquote (get data "server-results"))))
"deps"
(quasiquote
(~language/test/_shared/spec-content
:spec-name "deps"
:spec-title "Dependency Analysis Tests"
:spec-desc "33 tests covering component dependency analysis."
:spec-source (unquote (get data "spec-source"))
:framework-source (unquote (get data "framework-source"))
:server-results (unquote (get data "server-results"))))
"engine"
(quasiquote
(~language/test/_shared/spec-content
:spec-name "engine"
:spec-title "Engine Tests"
:spec-desc "37 tests covering engine pure functions."
:spec-source (unquote (get data "spec-source"))
:framework-source (unquote (get data "framework-source"))
:server-results (unquote (get data "server-results"))))
"orchestration"
(quasiquote
(~language/test/_shared/spec-content
:spec-name "orchestration"
:spec-title "Orchestration Tests"
:spec-desc "17 tests covering orchestration."
:spec-source (unquote (get data "spec-source"))
:framework-source (unquote (get data "framework-source"))
:server-results (unquote (get data "server-results"))))
:else (quasiquote
(~language/test
:server-results (unquote (get data "server-results")))))))))))
(define
reference
(fn
(slug)
(if
(nil? slug)
(quote (~geography/hypermedia/reference))
(let
((data (helper "reference-data" slug)))
(case
slug
"attributes"
(quasiquote
(~geography/hypermedia/reference/attributes
:req-table (~geography/hypermedia/reference/_shared/attr-table-from-data
:title "Request Attributes"
:attrs (unquote (get data "req-attrs")))
:beh-table (~geography/hypermedia/reference/_shared/attr-table-from-data
:title "Behavior Attributes"
:attrs (unquote (get data "beh-attrs")))
:uniq-table (~geography/hypermedia/reference/_shared/attr-table-from-data
:title "Unique to sx"
:attrs (unquote (get data "uniq-attrs")))))
"headers"
(quasiquote
(~geography/hypermedia/reference/headers
:req-table (~geography/hypermedia/reference/_shared/headers-table-from-data
:title "Request Headers"
:headers (unquote (get data "req-headers")))
:resp-table (~geography/hypermedia/reference/_shared/headers-table-from-data
:title "Response Headers"
:headers (unquote (get data "resp-headers")))))
"events"
(quasiquote
(~geography/hypermedia/reference/events
:table (~geography/hypermedia/reference/_shared/two-col-table-from-data
:intro "sx fires custom DOM events at various points in the request lifecycle."
:col1 "Event"
:col2 "Description"
:items (unquote (get data "events-list")))))
"js-api"
(quasiquote
(~geography/hypermedia/reference/js-api
:table (~geography/hypermedia/reference/_shared/two-col-table-from-data
:intro "The client-side sx.js library exposes a public API for programmatic use."
:col1 "Method"
:col2 "Description"
:items (unquote (get data "js-api-list")))))
:else (quasiquote
(~geography/hypermedia/reference/attributes
:req-table (~geography/hypermedia/reference/_shared/attr-table-from-data
:title "Request Attributes"
:attrs (unquote (get data "req-attrs")))
:beh-table (~geography/hypermedia/reference/_shared/attr-table-from-data
:title "Behavior Attributes"
:attrs (unquote (get data "beh-attrs")))
:uniq-table (~geography/hypermedia/reference/_shared/attr-table-from-data
:title "Unique to sx"
:attrs (unquote (get data "uniq-attrs"))))))))))
(define
reference-detail
(fn
(kind slug)
(if
(nil? slug)
nil
(case
kind
"attributes"
(let
((data (helper "attr-detail-data" slug)))
(if
(get data "attr-not-found")
(quasiquote
(~geography/hypermedia/reference/_shared/attr-not-found
:slug (unquote slug)))
(quasiquote
(~geography/hypermedia/reference/_shared/attr-detail-content
:title (unquote (get data "attr-title"))
:description (unquote (get data "attr-description"))
:demo (unquote (get data "attr-demo"))
:example-code (unquote (get data "attr-example"))
:handler-code (unquote (get data "attr-handler"))
:wire-placeholder-id (unquote (get data "attr-wire-id"))))))
"headers"
(let
((data (helper "header-detail-data" slug)))
(if
(get data "header-not-found")
(quasiquote
(~geography/hypermedia/reference/_shared/attr-not-found
:slug (unquote slug)))
(quasiquote
(~geography/hypermedia/reference/_shared/header-detail-content
:title (unquote (get data "header-title"))
:direction (unquote (get data "header-direction"))
:description (unquote (get data "header-description"))
:example-code (unquote (get data "header-example"))
:demo (unquote (get data "header-demo"))))))
"events"
(let
((data (helper "event-detail-data" slug)))
(if
(get data "event-not-found")
(quasiquote
(~geography/hypermedia/reference/_shared/attr-not-found
:slug (unquote slug)))
(quasiquote
(~geography/hypermedia/reference/_shared/event-detail-content
:title (unquote (get data "event-title"))
:description (unquote (get data "event-description"))
:example-code (unquote (get data "event-example"))
:demo (unquote (get data "event-demo"))))))
:else nil))))
(define
example
(fn
(slug)
(if
(nil? slug)
""
(list (slug->component slug "~geography/hypermedia/example/" nil "")))))
(define sx-urls (fn (slug) (quote (~applications/sx-urls))))
(define cssx (make-page-fn "~applications/cssx" "~applications/cssx/" nil ""))
(define
protocol
(make-page-fn "~applications/protocol" "~applications/protocol/" nil ""))
(define
sx-pub
(fn (slug) (if (nil? slug) (quote (~applications/sx-pub)) nil)))
(define
sx-tools
(fn
(&key title &rest args)
(quasiquote
(~tools/sx-tools
:title (unquote (or title "SX Tools"))
(splice-unquote args)))))
(define tools (fn (content) (or content "")))
(define
playground
(fn
(&key title &rest args)
(quasiquote
(~tools/playground
:title (unquote (or title "Playground"))
(splice-unquote args)))))
(define
services
(fn
(&key title &rest args)
(quasiquote
(~tools/services
:title (unquote (or title "Services"))
(splice-unquote args)))))
(define
reactive-runtime
(make-page-fn
"~geography/reactive-runtime"
"~geography/reactive-runtime/"
nil
""))
(define
native-browser
(make-page-fn
"~applications/native-browser"
"~applications/native-browser/"
nil
""))
(define essay (make-page-fn "~etc/essay" "~etc/essay/" nil ""))
(define
philosophy
(fn
(slug)
(if
(nil? slug)
(quote (~etc/philosophy))
(case
slug
"sx-manifesto"
(quote (~etc/philosophy/sx-manifesto))
"godel-escher-bach"
(quote (~etc/philosophy/godel-escher-bach))
"wittgenstein"
(quote (~etc/philosophy/wittgenstein))
"dennett"
(quote (~etc/philosophy/dennett))
"existentialism"
(quote (~etc/philosophy/existentialism))
"platonic-sx"
(quote (~etc/philosophy/platonic-sx))
:else (quote (~etc/philosophy))))))
(define plan (make-page-fn "~etc/plan" "~etc/plan/" nil ""))
(define
capabilities
(fn (&key title &rest args) (quasiquote (~geography/capabilities))))
(define
modules
(fn (&key title &rest args) (quasiquote (~geography/modules))))
(define
eval-rules
(fn (&key title &rest args) (quasiquote (~geography/eval-rules))))
(define
hyperscript
(make-page-fn
"~applications/hyperscript"
"~applications/hyperscript/"
nil
""))
(define htmx (make-page-fn "~applications/htmx" "~applications/htmx/" nil ""))
(define sxtp (make-page-fn "~applications/sxtp" "~applications/sxtp/" nil ""))
(define
graphql
(make-page-fn "~applications/graphql" "~applications/graphql/" nil ""))
(define
pretext
(make-page-fn "~applications/pretext" "~applications/pretext/" nil ""))