96 lines
3.1 KiB
Plaintext
96 lines
3.1 KiB
Plaintext
(define
|
|
sx-url-to-expr
|
|
(fn
|
|
(path)
|
|
(cond
|
|
(or (= path "/") (= path "/sx/") (= path "/sx"))
|
|
"home"
|
|
(starts-with? path "/sx/")
|
|
(join " " (split (slice path 4 (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 (if (= (len exprs) 1) (first exprs) exprs))
|
|
(quoted (sx-auto-quote expr env))
|
|
(callable (if (symbol? quoted) (list quoted) quoted)))
|
|
(eval-expr callable env)))))
|
|
(fn (err) nil))))
|
|
|
|
(define
|
|
sx-handle-request
|
|
(fn
|
|
(path headers env)
|
|
(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
|
|
((nav-path (if (starts-with? path "/sx/") path (str "/sx" path))))
|
|
(cek-try
|
|
(fn
|
|
()
|
|
(if
|
|
is-ajax
|
|
(let
|
|
((content (list (make-symbol "~layouts/doc") :path nav-path page-ast)))
|
|
(render-to-html content env))
|
|
(let
|
|
((wrapped (list (make-symbol "~layouts/doc") :path nav-path page-ast))
|
|
(full-ast
|
|
(list
|
|
(make-symbol "~shared:layout/app-body")
|
|
:content wrapped))
|
|
(body-html (render-to-html full-ast env)))
|
|
(render-to-html
|
|
(list
|
|
(make-symbol "~shared:shell/sx-page-shell")
|
|
:title "SX"
|
|
:csrf ""
|
|
:page-sx (serialize full-ast)
|
|
:body-html body-html
|
|
:component-defs __shell-component-defs
|
|
:component-hash __shell-component-hash
|
|
:pages-sx __shell-pages-sx
|
|
:sx-css __shell-sx-css
|
|
:sx-css-classes __shell-sx-css-classes
|
|
:asset-url __shell-asset-url
|
|
:sx-js-hash __shell-sx-js-hash
|
|
:body-js-hash __shell-body-js-hash
|
|
:wasm-hash __shell-wasm-hash
|
|
:head-scripts __shell-head-scripts
|
|
:body-scripts __shell-body-scripts
|
|
:inline-css __shell-inline-css
|
|
:inline-head-js __shell-inline-head-js
|
|
:init-sx __shell-init-sx
|
|
:use-wasm true
|
|
:meta-html "")
|
|
env))))
|
|
(fn (err) (str "<h1>Render error</h1><pre>" err "</pre>"))))))))
|