giles
ac65666f6f
- 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>
75 lines
2.7 KiB
Plaintext
75 lines
2.7 KiB
Plaintext
|
|
|
|
(define-library
|
|
(web request-handler)
|
|
(export sx-url-to-expr sx-auto-quote sx-eval-page sx-handle-request)
|
|
(begin
|
|
(define
|
|
sx-url-to-expr
|
|
(fn
|
|
(path)
|
|
(let
|
|
((prefix (cek-try (fn () (or (dict-get __app-config :path-prefix) "/sx/")) (fn (e) "/sx/")))
|
|
(prefix-len (len prefix))
|
|
(prefix-bare (slice prefix 0 (- prefix-len 1))))
|
|
(cond
|
|
(or (= path "/") (= path prefix) (= path prefix-bare))
|
|
"home"
|
|
(starts-with? path prefix)
|
|
(join " " (split (slice path prefix-len (len path)) "."))
|
|
(starts-with? path "/")
|
|
(join " " (split (slice path 1 (len path)) "."))
|
|
:else path))))
|
|
(define
|
|
sx-auto-quote
|
|
(fn
|
|
(expr env)
|
|
(cond
|
|
(and (symbol? expr) (not (env-has? env (symbol-name expr))))
|
|
(symbol-name expr)
|
|
(list? expr)
|
|
(map (fn (e) (sx-auto-quote e env)) expr)
|
|
:else expr)))
|
|
(define
|
|
sx-eval-page
|
|
(fn
|
|
(path-expr env)
|
|
(cek-try
|
|
(fn
|
|
()
|
|
(let
|
|
((exprs (sx-parse path-expr)))
|
|
(when
|
|
(not (empty? exprs))
|
|
(let
|
|
((expr (first exprs)) (quoted (sx-auto-quote expr env)))
|
|
(letrec
|
|
((call-page (fn (e) (cond (symbol? e) (let ((f (env-get env (symbol-name e)))) (f nil)) (list? e) (let ((head (first e)) (args (rest e))) (if (symbol? head) (let ((f (env-get env (symbol-name head))) (evaled-args (map call-page args))) (apply f evaled-args)) (eval-expr e env))) :else (eval-expr e env)))))
|
|
(call-page quoted))))))
|
|
(fn (err) nil))))
|
|
(define
|
|
sx-handle-request
|
|
(fn
|
|
(path headers env shell-vars)
|
|
(let
|
|
((is-ajax (or (has-key? headers "sx-request") (has-key? headers "hx-request")))
|
|
(path-expr (sx-url-to-expr path))
|
|
(page-ast (sx-eval-page path-expr env)))
|
|
(if
|
|
(nil? page-ast)
|
|
nil
|
|
(let
|
|
((prefix (cek-try (fn () (or (dict-get __app-config :path-prefix) "/sx/")) (fn (e) "/sx/")))
|
|
(prefix-len (len prefix))
|
|
(nav-path
|
|
(if
|
|
(and
|
|
(>= (len path) prefix-len)
|
|
(= (slice path 0 prefix-len) prefix))
|
|
path
|
|
(str (slice prefix 0 (- prefix-len 1)) path))))
|
|
{:page-ast page-ast :nav-path nav-path :is-ajax is-ajax}))))))) ;; end define-library
|
|
|
|
;; Re-export to global namespace for backward compatibility
|
|
(import (web request-handler))
|