Compare commits
423 Commits
3749fe9625
...
macros
| Author | SHA1 | Date | |
|---|---|---|---|
| 5ab3ecb7e0 | |||
| 313f7d6be1 | |||
| 16fa813d6d | |||
| 818e5d53f0 | |||
| 3a268e7277 | |||
| bdbf594bc8 | |||
| a1fa1edf8a | |||
| 2ef3f03db3 | |||
| 9f32c8cf0d | |||
| 719da7914e | |||
| c6a662c980 | |||
| e475222099 | |||
| b4df216fae | |||
| 9b4f735a0e | |||
| 293af75821 | |||
| ebb3445667 | |||
| 8f146cc810 | |||
| c67adaceaf | |||
| a2ab12a1d5 | |||
| 5a03943b39 | |||
| c20369b766 | |||
| 237ac234df | |||
| 4b21efc43c | |||
| 1ea80a2b71 | |||
| c3aee94c8f | |||
| 1800b80316 | |||
| 1a5dbc2800 | |||
| 7cde140c7e | |||
| 72eaefac13 | |||
| 7036621be8 | |||
| 05f7b10864 | |||
| 8ed8134d66 | |||
| f8a8e1eeb0 | |||
| 1a3d7b3d77 | |||
| ab015fa2fd | |||
| b3a7df45e6 | |||
| e2940e1c5f | |||
| f7debec7c6 | |||
| 488fc53fda | |||
| cb4f4b85e5 | |||
| a759f4da3b | |||
| b03c84b962 | |||
| 4dd9968264 | |||
| 7cc1bffc23 | |||
| 169097097c | |||
| a7638e48d5 | |||
| 93e140280b | |||
| 07bf5a1142 | |||
| 623f947b52 | |||
| 41f4772ba7 | |||
| ae1ba46b44 | |||
| 0047757af8 | |||
| b3cba5e281 | |||
| 48d493e9cc | |||
| 7556cc303d | |||
| 919998be1c | |||
| 2211655060 | |||
| d0a5ce1070 | |||
| 6581211a10 | |||
| 455e48df07 | |||
| 30d9d4aa4c | |||
| b06cc2daca | |||
| 4b746e4c8b | |||
| f96506024e | |||
| 203f9a49a1 | |||
| 893c767238 | |||
| 5c4a8c8cc2 | |||
| 90febbd91e | |||
| f3a9f3ccc0 | |||
| dcc73a68d5 | |||
| 1765216335 | |||
| 11fdd1a840 | |||
| 6ca46bb295 | |||
| e1a5e3eb89 | |||
| aef990735f | |||
| 04d3b2ecaf | |||
| c4a999d0d0 | |||
| 2de4ba8c57 | |||
| ee969a343c | |||
| 400d6d4086 | |||
| dbf16929fa | |||
| 859aad4333 | |||
| c95e320825 | |||
| 427dee13f0 | |||
| a7de0e9410 | |||
| 214963ea6a | |||
| 2fc391696c | |||
| 28a6560963 | |||
| cee0ca7667 | |||
| 98036b2292 | |||
| 6d0c0b2230 | |||
| 9d0bd3b0e7 | |||
| 2329533d1a | |||
| 085f959323 | |||
| fe911625e3 | |||
| 9806aec60c | |||
| 36b070f796 | |||
| ae6c6d06a7 | |||
| 846719908f | |||
| 301bb8e585 | |||
| d42972518a | |||
| 071869331f | |||
| 2fd64351d0 | |||
| 9096476402 | |||
| 0847824935 | |||
| b31eb393c4 | |||
| 2c97542ee8 | |||
| 04539675d8 | |||
| 1d1e7f30bb | |||
| 56dfff8299 | |||
| f52b9e880b | |||
| a0d78e44d5 | |||
| 9284a946ba | |||
| 11ea641f7b | |||
| c3430ade90 | |||
| 1f22f3fcd5 | |||
| 8100dc5fc9 | |||
| 5f6600f572 | |||
| ea2b71cfa3 | |||
| 41097eeef9 | |||
| c2efa192c5 | |||
| 100450772f | |||
| 7c969f9192 | |||
| bc1ea0128f | |||
| 0358b6ec9e | |||
| a2d8fb0f0f | |||
| cedff42d15 | |||
| 1324e984ef | |||
| 5f06e2e2cc | |||
| b9d85bd797 | |||
| 1dd2d73766 | |||
| 355f57a60b | |||
| c6a4a6f65c | |||
| 6186cd1c53 | |||
| 1647921895 | |||
| b0920a1121 | |||
| de80d921e9 | |||
| acd2fa6541 | |||
| b23e81730c | |||
| 7a1d1e9ea2 | |||
| 9f2f4377b9 | |||
| f759cd6688 | |||
| 2076e1805f | |||
| feecbb66ba | |||
| da1ca6009a | |||
| 0cc2f178a9 | |||
| 2d3c79d999 | |||
| 78b4d0f1ac | |||
| c440c26292 | |||
| 33586024a7 | |||
| 1fce4970fb | |||
| 17c58a2b5b | |||
| c23d0888ea | |||
| 95e42f9a87 | |||
| 1b6612fd08 | |||
| 00cf6bbd75 | |||
| 6a68894f7d | |||
| ac72a4de8d | |||
| 2dc13ab34f | |||
| 7515634901 | |||
| c5a4340293 | |||
| 365440d42f | |||
| fe36877c71 | |||
| 4aa2133b39 | |||
| c2d9a3d2b1 | |||
| 575d100f67 | |||
| 56f49f29fb | |||
| e046542aa0 | |||
| 89e8645d8f | |||
| fba84540e2 | |||
| 4e96997e09 | |||
| 2f42e8826c | |||
| 524c99e4ff | |||
| 0f9b449315 | |||
| a69604acaf | |||
| ce7ad125b6 | |||
| 8f88e52b27 | |||
| b8018ba385 | |||
| 95ffc0ecb7 | |||
| 477ce766ff | |||
| 98c1023b81 | |||
| b99e69d1bb | |||
| a425ea8ed4 | |||
| c82941d93c | |||
| 9b38ef2ce9 | |||
| 4d54be6b6b | |||
| 5d5512e74a | |||
| 8a530569a2 | |||
| b82fd7822d | |||
| e5dbe9f3da | |||
| 0174fbfea3 | |||
| cd7653d8c3 | |||
| ff6c1fab71 | |||
| e843602ac9 | |||
| c95e19dcf2 | |||
| 29c90a625b | |||
| 4c4806c8dd | |||
| d8cddbd971 | |||
| 3906ab3558 | |||
| 46cd179703 | |||
| 5d3676d751 | |||
| 86363d9f34 | |||
| 8586f54dcb | |||
| f54ebf26f8 | |||
| 0a7a9aa5ae | |||
| f1e0e0d0a3 | |||
| 1341c144da | |||
| e149dfe968 | |||
| b8c5426093 | |||
| 9b9fc6b6a5 | |||
| d5e416e478 | |||
| 8a5c115557 | |||
| 31a6e708fc | |||
| ec1093d372 | |||
| cad65bcdf1 | |||
| e6ca1a5f44 | |||
| fd4f13e571 | |||
| e5acfdcd3c | |||
| b4944aa2b6 | |||
| e4e8b45cb4 | |||
| db1691d8f5 | |||
| 192d48d0e3 | |||
| c0ced8a40f | |||
| ff41fa2238 | |||
| 00e7ba4650 | |||
| 7b8ae473a5 | |||
| 3ca89ef765 | |||
| 8b1333de96 | |||
| f9939a660c | |||
| 8be8926155 | |||
| 03ba8e58e5 | |||
| 56589a81b2 | |||
| 06adbdcd59 | |||
| 7efd1b401b | |||
| a496ee6ae6 | |||
| 6bda2bafa2 | |||
| 3103d7ff9d | |||
| 8683cf24c3 | |||
| efc7e340da | |||
| 09164e32ad | |||
| 189a0258d9 | |||
| 9a0173419a | |||
| 50a184faf2 | |||
| 4709c6bf49 | |||
| e15b5c9dbc | |||
| c55f0956bc | |||
| 5b70cd5cfc | |||
| 0da5dc41e1 | |||
| 57ff7705c7 | |||
| c344b0d7b0 | |||
| baa9d66a59 | |||
| cf2e386cda | |||
| fe289287ec | |||
| 26320abd64 | |||
| a97f4c0e39 | |||
| 391a0c675b | |||
| 145028ccc0 | |||
| c7c824c488 | |||
| 7f665d874c | |||
| 599964c39c | |||
| b2aaa3786d | |||
| 2d38a76f0b | |||
| 5f20a16aa0 | |||
| dba5bf05fa | |||
| 4c1853bc7b | |||
| 3cbdfd8f7f | |||
| 7f1dad6bfd | |||
| 0ce3f95d6c | |||
| 9a707dbe56 | |||
| 069d7e7090 | |||
| 09947262a5 | |||
| ec52e2116e | |||
| 657b631700 | |||
| 32ca059ed7 | |||
| 2da80c69ed | |||
| a8bfff9e0b | |||
| a70ff2b153 | |||
| 81d8e55fb0 | |||
| 179631130c | |||
| 5a4a0c0e1c | |||
| 621c0bbf42 | |||
| 5a68046bd8 | |||
| df1aa4e1d1 | |||
| 41c3b9f3b8 | |||
| f5e47678d5 | |||
| 6596fac758 | |||
| 299de98ea8 | |||
| e7a511d40a | |||
| aeac3c0b13 | |||
| 25edc7d64a | |||
| 5cca22ae6d | |||
| 260475a4da | |||
| 2c9d7c95a2 | |||
| fd03eeb0fe | |||
| 47448a6d37 | |||
| cdd775c999 | |||
| 7294f07f5b | |||
| dd774efc18 | |||
| 668a46bec0 | |||
| 9d70599416 | |||
| 309579aec7 | |||
| ca0ea69ca1 | |||
| 44095c0a04 | |||
| 5991a5b397 | |||
| b9b315c86f | |||
| ccf9a155ad | |||
| fa70c5f297 | |||
| 3574f7e163 | |||
| 6312eb66a2 | |||
| 917a487195 | |||
| 605aafa2eb | |||
| 7f466f0fd6 | |||
| 6421a23223 | |||
| 342da2bd44 | |||
| a05d642461 | |||
| 1fe258e3f7 | |||
| bec0397c3c | |||
| 85083a0fff | |||
| fab9bffc49 | |||
| d618530f29 | |||
| 624d1872e3 | |||
| 3b3c904953 | |||
| 3119b8e310 | |||
| aab1f3e966 | |||
| 79025b9913 | |||
| 99a78a70b3 | |||
| 72148fa4c0 | |||
| 84f66557df | |||
| b6ba7ad6be | |||
| 6f403c0c2d | |||
| 3ab26635ce | |||
| 9b3b2ea224 | |||
| 3a12368c9d | |||
| bec881acb3 | |||
| e89c496dc8 | |||
| 7eb158c79f | |||
| e9d86d628b | |||
| 754e7557f5 | |||
| f674a5edcc | |||
| e09bc3b601 | |||
| 43f2547de8 | |||
| 8366088ee1 | |||
| fd20811afa | |||
| 84ea5d4c16 | |||
| 51990d9445 | |||
| 0d6b959045 | |||
| 847d5d1f31 | |||
| ff2ef29d8a | |||
| ab27491157 | |||
| aa67b036c7 | |||
| 9ac90a787d | |||
| cb0990feb3 | |||
| 8c89311182 | |||
| a745de7e35 | |||
| a5f5373a63 | |||
| c2a85ed026 | |||
| 69ced865db | |||
| 2b0a45b337 | |||
| feb368f7fb | |||
| 6215d3573b | |||
| 79fa1411dc | |||
| 04ff03f5d4 | |||
| b85a46bb62 | |||
| 09d06a4c87 | |||
| 6655f638b9 | |||
| 2c56d3e14b | |||
| fa295acfe3 | |||
| 28ee441d9a | |||
| 1387d97c82 | |||
| b90cc59029 | |||
| 59c935e394 | |||
| c15dbc3242 | |||
| ece2aa225d | |||
| ac1dc34dad | |||
| 9278be9fe2 | |||
| f36583b620 | |||
| 6772f1141f | |||
| 60b58fdff7 | |||
| d3617ab7f3 | |||
| 732923a7ef | |||
| b1f9e41027 | |||
| a657d0831c | |||
| 9d0cffb84d | |||
| eee2954559 | |||
| b9003eacb2 | |||
| 7229335d22 | |||
| e38534a898 | |||
| daf76c3e5b | |||
| 093050059d | |||
| 6a5cb31123 | |||
| bcb58d340f | |||
| b98a8f8c41 | |||
| 14c5316d17 | |||
| 3b00a7095a | |||
| 719dfbf732 | |||
| 5ea0f5c546 | |||
| 74428cc433 | |||
| d1a47e1e52 | |||
| 3d191099e0 | |||
| 70cf501c49 | |||
| 2a978e6e9f | |||
| 3a8ee0dbd6 | |||
| c346f525d2 | |||
| 79ee3bc46e | |||
| c80b5d674f | |||
| f08bd403de | |||
| 227444a026 | |||
| 2660d37f9e | |||
| d850f7c9c1 | |||
| bc9d9e51c9 | |||
| eb70e7237e | |||
| a7d09291b8 | |||
| 2d5096be6c | |||
| f70861c175 | |||
| 78c3ff30dd | |||
| 756162b63f | |||
| 0385be0a0d | |||
| 1e52bb33a6 | |||
| a8e61dd0ea | |||
| 20ac0fe948 | |||
| 2aa0f1d010 | |||
| a2d0a8a0fa | |||
| b8d3e46a9b |
278
.claude/plans/sx-ci-pipeline.md
Normal file
278
.claude/plans/sx-ci-pipeline.md
Normal file
@@ -0,0 +1,278 @@
|
||||
# SX CI Pipeline — Build/Test/Deploy in S-Expressions
|
||||
|
||||
## Context
|
||||
|
||||
Rose Ash currently uses shell scripts for CI:
|
||||
- `deploy.sh` — auto-detect changed apps via git diff, build Docker images, push to registry, restart services
|
||||
- `dev.sh` — start/stop dev environment, run tests
|
||||
- `test/Dockerfile.unit` — headless test runner in Docker
|
||||
- Tailwind CSS build via CLI command with v3 config
|
||||
- SX bootstrapping via `python bootstrap_js.py`, `python bootstrap_py.py`, `python bootstrap_test.py`
|
||||
|
||||
These work, but they are opaque shell scripts with imperative logic, no reuse, and no relationship to the language the application is written in. The CI pipeline is the one remaining piece of Rose Ash infrastructure that is not expressed in s-expressions.
|
||||
|
||||
## Goal
|
||||
|
||||
Replace the shell-based CI with pipeline definitions written in SX. The pipeline runner is a minimal Python CLI that evaluates `.sx` files using the SX spec. Pipeline steps are s-expressions. Conditionals, composition, and reuse are the same language constructs used everywhere else in the codebase.
|
||||
|
||||
This is not a generic CI framework — it is a project-specific pipeline that happens to be written in SX, proving the "one representation for everything" claim from the essays.
|
||||
|
||||
## Design Principles
|
||||
|
||||
1. **Same language** — Pipeline definitions use the same SX syntax, parser, and evaluator as the application
|
||||
2. **Boundary-enforced** — CI primitives (shell, docker, git) are IO primitives declared in boundary.sx, sandboxed like everything else
|
||||
3. **Composable** — Pipeline steps are components; complex pipelines compose them by nesting
|
||||
4. **Self-testing** — The pipeline can run the SX spec tests as a pipeline step, using the same spec that defines the pipeline language
|
||||
5. **Incremental** — Each phase is independently useful; shell scripts remain as fallback
|
||||
|
||||
## Implementation
|
||||
|
||||
### Phase 1: CI Spec + Runner
|
||||
|
||||
#### `shared/sx/ref/ci.sx` — CI primitives spec
|
||||
|
||||
Declare CI-specific IO primitives in the boundary:
|
||||
|
||||
```lisp
|
||||
;; Shell execution
|
||||
(define shell-run ...) ;; (shell-run "pytest shared/ -v") → {:exit 0 :stdout "..." :stderr "..."}
|
||||
(define shell-run! ...) ;; Like shell-run but throws on non-zero exit
|
||||
|
||||
;; Docker
|
||||
(define docker-build ...) ;; (docker-build :file "sx/Dockerfile" :tag "registry/sx:latest" :context ".")
|
||||
(define docker-push ...) ;; (docker-push "registry/sx:latest")
|
||||
(define docker-restart ...) ;; (docker-restart "coop_sx_docs")
|
||||
|
||||
;; Git
|
||||
(define git-diff-files ...) ;; (git-diff-files "HEAD~1" "HEAD") → ("shared/sx/parser.py" "sx/sx/essays.sx")
|
||||
(define git-branch ...) ;; (git-branch) → "macros"
|
||||
|
||||
;; Filesystem
|
||||
(define file-exists? ...) ;; (file-exists? "sx/Dockerfile") → true
|
||||
(define read-file ...) ;; (read-file "version.txt") → "1.2.3"
|
||||
|
||||
;; Pipeline control
|
||||
(define log-step ...) ;; (log-step "Building sx_docs") — formatted output
|
||||
(define fail! ...) ;; (fail! "Unit tests failed") — abort pipeline
|
||||
```
|
||||
|
||||
#### `sx-ci` — CLI runner
|
||||
|
||||
Minimal Python script (~100 lines):
|
||||
1. Loads SX evaluator (sx_ref.py)
|
||||
2. Registers CI IO primitives (subprocess, docker SDK, git)
|
||||
3. Evaluates the pipeline `.sx` file
|
||||
4. Exit code = pipeline result
|
||||
|
||||
```bash
|
||||
python -m shared.sx.ci pipeline/deploy.sx
|
||||
python -m shared.sx.ci pipeline/test.sx
|
||||
```
|
||||
|
||||
### Phase 2: Pipeline Definitions
|
||||
|
||||
#### `pipeline/services.sx` — Service registry (data)
|
||||
|
||||
```lisp
|
||||
(define services
|
||||
(list
|
||||
{:name "blog" :dir "blog" :compose "blog" :port 8001}
|
||||
{:name "market" :dir "market" :compose "market" :port 8002}
|
||||
{:name "cart" :dir "cart" :compose "cart" :port 8003}
|
||||
{:name "events" :dir "events" :compose "events" :port 8004}
|
||||
{:name "federation" :dir "federation" :compose "federation" :port 8005}
|
||||
{:name "account" :dir "account" :compose "account" :port 8006}
|
||||
{:name "relations" :dir "relations" :compose "relations" :port 8008}
|
||||
{:name "likes" :dir "likes" :compose "likes" :port 8009}
|
||||
{:name "orders" :dir "orders" :compose "orders" :port 8010}
|
||||
{:name "sx_docs" :dir "sx" :compose "sx_docs" :port 8011}))
|
||||
|
||||
(define registry "registry.rose-ash.com:5000")
|
||||
```
|
||||
|
||||
#### `pipeline/steps.sx` — Reusable step components
|
||||
|
||||
```lisp
|
||||
(defcomp ~detect-changed (&key base)
|
||||
;; Returns list of services whose source dirs have changes
|
||||
(let ((files (git-diff-files (or base "HEAD~1") "HEAD")))
|
||||
(if (some (fn (f) (starts-with? f "shared/")) files)
|
||||
services ;; shared changed → rebuild all
|
||||
(filter (fn (svc)
|
||||
(some (fn (f) (starts-with? f (str (get svc "dir") "/"))) files))
|
||||
services))))
|
||||
|
||||
(defcomp ~unit-tests ()
|
||||
(log-step "Running unit tests")
|
||||
(shell-run! "docker build -f test/Dockerfile.unit -t rose-ash-test-unit:latest . -q")
|
||||
(shell-run! "docker run --rm rose-ash-test-unit:latest"))
|
||||
|
||||
(defcomp ~sx-spec-tests ()
|
||||
(log-step "Running SX spec tests")
|
||||
(shell-run! "cd shared/sx/ref && python bootstrap_test.py")
|
||||
(shell-run! "node shared/sx/ref/test_sx_ref.js"))
|
||||
|
||||
(defcomp ~bootstrap-check ()
|
||||
(log-step "Checking bootstrapped files are up to date")
|
||||
;; Rebootstrap and check for diff
|
||||
(shell-run! "python shared/sx/ref/bootstrap_js.py")
|
||||
(shell-run! "python shared/sx/ref/bootstrap_py.py")
|
||||
(let ((diff (shell-run "git diff --name-only shared/static/scripts/sx-ref.js shared/sx/ref/sx_ref.py")))
|
||||
(when (not (= (get diff "stdout") ""))
|
||||
(fail! "Bootstrapped files are stale — rebootstrap and commit"))))
|
||||
|
||||
(defcomp ~tailwind-check ()
|
||||
(log-step "Checking tw.css is up to date")
|
||||
(shell-run! "cat <<'CSS' | npx tailwindcss -i /dev/stdin -o /tmp/tw-check.css --minify -c shared/static/styles/tailwind.config.js\n@tailwind base;\n@tailwind components;\n@tailwind utilities;\nCSS")
|
||||
(let ((diff (shell-run "diff shared/static/styles/tw.css /tmp/tw-check.css")))
|
||||
(when (not (= (get diff "exit") 0))
|
||||
(log-step "WARNING: tw.css may be stale"))))
|
||||
|
||||
(defcomp ~build-service (&key service)
|
||||
(let ((name (get service "name"))
|
||||
(dir (get service "dir"))
|
||||
(tag (str registry "/" name ":latest")))
|
||||
(log-step (str "Building " name))
|
||||
(docker-build :file (str dir "/Dockerfile") :tag tag :context ".")
|
||||
(docker-push tag)))
|
||||
|
||||
(defcomp ~restart-service (&key service)
|
||||
(let ((name (get service "compose")))
|
||||
(log-step (str "Restarting coop_" name))
|
||||
(docker-restart (str "coop_" name))))
|
||||
```
|
||||
|
||||
#### `pipeline/test.sx` — Test pipeline
|
||||
|
||||
```lisp
|
||||
(load "pipeline/steps.sx")
|
||||
|
||||
(do
|
||||
(~unit-tests)
|
||||
(~sx-spec-tests)
|
||||
(~bootstrap-check)
|
||||
(~tailwind-check)
|
||||
(log-step "All checks passed"))
|
||||
```
|
||||
|
||||
#### `pipeline/deploy.sx` — Deploy pipeline
|
||||
|
||||
```lisp
|
||||
(load "pipeline/services.sx")
|
||||
(load "pipeline/steps.sx")
|
||||
|
||||
(let ((targets (if (= (length ARGS) 0)
|
||||
(~detect-changed :base "HEAD~1")
|
||||
(filter (fn (svc) (some (fn (a) (= a (get svc "name"))) ARGS)) services))))
|
||||
(when (= (length targets) 0)
|
||||
(log-step "No changes detected")
|
||||
(exit 0))
|
||||
|
||||
(log-step (str "Deploying: " (join " " (map (fn (s) (get s "name")) targets))))
|
||||
|
||||
;; Tests first
|
||||
(~unit-tests)
|
||||
(~sx-spec-tests)
|
||||
|
||||
;; Build and push
|
||||
(for-each (fn (svc) (~build-service :service svc)) targets)
|
||||
|
||||
;; Restart
|
||||
(for-each (fn (svc) (~restart-service :service svc)) targets)
|
||||
|
||||
(log-step "Deploy complete"))
|
||||
```
|
||||
|
||||
### Phase 3: Boundary Integration
|
||||
|
||||
Add CI primitives to `boundary.sx`:
|
||||
|
||||
```lisp
|
||||
;; CI primitives (pipeline runner only — not available in web context)
|
||||
(io-primitive shell-run (command) -> dict)
|
||||
(io-primitive shell-run! (command) -> dict)
|
||||
(io-primitive docker-build (&key file tag context) -> nil)
|
||||
(io-primitive docker-push (tag) -> nil)
|
||||
(io-primitive docker-restart (service) -> nil)
|
||||
(io-primitive git-diff-files (base head) -> list)
|
||||
(io-primitive git-branch () -> string)
|
||||
(io-primitive file-exists? (path) -> boolean)
|
||||
(io-primitive read-file (path) -> string)
|
||||
(io-primitive log-step (message) -> nil)
|
||||
(io-primitive fail! (message) -> nil)
|
||||
```
|
||||
|
||||
These are only registered by the CI runner, never by the web app. The boundary enforces that web components cannot call `shell-run!`.
|
||||
|
||||
### Phase 4: Bootstrap + Runner Implementation
|
||||
|
||||
#### `shared/sx/ci.py` — Runner module
|
||||
|
||||
```python
|
||||
"""SX CI pipeline runner.
|
||||
|
||||
Usage: python -m shared.sx.ci pipeline/deploy.sx [args...]
|
||||
"""
|
||||
import sys, subprocess, os
|
||||
from .ref.sx_ref import evaluate, parse, create_env
|
||||
from .ref.boundary_parser import parse_boundary
|
||||
|
||||
def register_ci_primitives(env):
|
||||
"""Register CI IO primitives into the evaluation environment."""
|
||||
# shell-run, docker-build, git-diff-files, etc.
|
||||
# Each is a thin Python wrapper around subprocess/docker SDK
|
||||
...
|
||||
|
||||
def main():
|
||||
pipeline_file = sys.argv[1]
|
||||
args = sys.argv[2:]
|
||||
|
||||
env = create_env()
|
||||
register_ci_primitives(env)
|
||||
env_set(env, "ARGS", args)
|
||||
|
||||
with open(pipeline_file) as f:
|
||||
source = f.read()
|
||||
|
||||
result = evaluate(parse(source), env)
|
||||
sys.exit(0 if result else 1)
|
||||
```
|
||||
|
||||
### Phase 5: Documentation + Essay Section
|
||||
|
||||
- Add a section to the "No Alternative" essay about CI pipelines as proof of universality
|
||||
- Add a plan page at `/plans/sx-ci` documenting the pipeline architecture
|
||||
- The pipeline definitions themselves serve as examples of SX beyond web rendering
|
||||
|
||||
## Files
|
||||
|
||||
| File | Change |
|
||||
|------|--------|
|
||||
| `shared/sx/ref/ci.sx` | **NEW** — CI primitive declarations |
|
||||
| `shared/sx/ci.py` | **NEW** — Pipeline runner (~150 lines) |
|
||||
| `shared/sx/ci_primitives.py` | **NEW** — CI IO primitive implementations |
|
||||
| `pipeline/services.sx` | **NEW** — Service registry data |
|
||||
| `pipeline/steps.sx` | **NEW** — Reusable pipeline step components |
|
||||
| `pipeline/test.sx` | **NEW** — Test pipeline |
|
||||
| `pipeline/deploy.sx` | **NEW** — Deploy pipeline |
|
||||
| `shared/sx/ref/boundary.sx` | Add CI primitive declarations |
|
||||
| `sx/sx/plans.sx` | Add plan page |
|
||||
| `sx/sx/essays.sx` | Add CI section to "No Alternative" |
|
||||
|
||||
## Verification
|
||||
|
||||
1. `python -m shared.sx.ci pipeline/test.sx` — runs all checks, same results as manual
|
||||
2. `python -m shared.sx.ci pipeline/deploy.sx blog` — builds and deploys blog only
|
||||
3. `python -m shared.sx.ci pipeline/deploy.sx` — auto-detects changes, deploys affected services
|
||||
4. Pipeline output is readable: step names, pass/fail, timing
|
||||
5. Shell scripts remain as fallback — nothing is deleted
|
||||
|
||||
## Order of Implementation
|
||||
|
||||
1. Phase 1 first — get the runner evaluating simple pipeline files
|
||||
2. Phase 2 — define the actual pipeline steps
|
||||
3. Phase 3 — formal boundary declarations
|
||||
4. Phase 4 — full runner with all CI primitives
|
||||
5. Phase 5 — documentation and essay content
|
||||
|
||||
Each phase is independently committable and testable.
|
||||
@@ -7,6 +7,7 @@ on:
|
||||
env:
|
||||
REGISTRY: registry.rose-ash.com:5000
|
||||
APP_DIR: /root/rose-ash
|
||||
BUILD_DIR: /root/rose-ash-ci
|
||||
|
||||
jobs:
|
||||
build-and-deploy:
|
||||
@@ -33,23 +34,26 @@ jobs:
|
||||
DEPLOY_HOST: ${{ secrets.DEPLOY_HOST }}
|
||||
run: |
|
||||
ssh "root@$DEPLOY_HOST" "
|
||||
cd ${{ env.APP_DIR }}
|
||||
|
||||
# Save current HEAD before updating
|
||||
OLD_HEAD=\$(git rev-parse HEAD 2>/dev/null || echo none)
|
||||
|
||||
git fetch origin ${{ github.ref_name }}
|
||||
# --- Build in isolated CI directory (never touch dev working tree) ---
|
||||
BUILD=${{ env.BUILD_DIR }}
|
||||
ORIGIN=\$(git -C ${{ env.APP_DIR }} remote get-url origin)
|
||||
if [ ! -d \"\$BUILD/.git\" ]; then
|
||||
git clone \"\$ORIGIN\" \"\$BUILD\"
|
||||
fi
|
||||
cd \"\$BUILD\"
|
||||
git fetch origin
|
||||
git reset --hard origin/${{ github.ref_name }}
|
||||
|
||||
NEW_HEAD=\$(git rev-parse HEAD)
|
||||
# Detect changes using push event SHAs (not local checkout state)
|
||||
BEFORE='${{ github.event.before }}'
|
||||
AFTER='${{ github.sha }}'
|
||||
|
||||
# Detect what changed
|
||||
REBUILD_ALL=false
|
||||
if [ \"\$OLD_HEAD\" = \"none\" ] || [ \"\$OLD_HEAD\" = \"\$NEW_HEAD\" ]; then
|
||||
# First deploy or CI re-run on same commit — rebuild all
|
||||
if [ -z \"\$BEFORE\" ] || [ \"\$BEFORE\" = '0000000000000000000000000000000000000000' ] || ! git cat-file -e \"\$BEFORE\" 2>/dev/null; then
|
||||
# New branch, force push, or unreachable parent — rebuild all
|
||||
REBUILD_ALL=true
|
||||
else
|
||||
CHANGED=\$(git diff --name-only \$OLD_HEAD \$NEW_HEAD)
|
||||
CHANGED=\$(git diff --name-only \$BEFORE \$AFTER)
|
||||
if echo \"\$CHANGED\" | grep -q '^shared/'; then
|
||||
REBUILD_ALL=true
|
||||
fi
|
||||
@@ -86,8 +90,8 @@ jobs:
|
||||
|
||||
# Deploy swarm stacks only on main branch
|
||||
if [ '${{ github.ref_name }}' = 'main' ]; then
|
||||
source .env
|
||||
docker stack deploy -c docker-compose.yml rose-ash
|
||||
source ${{ env.APP_DIR }}/.env
|
||||
docker stack deploy --resolve-image always -c docker-compose.yml rose-ash
|
||||
echo 'Waiting for swarm services to update...'
|
||||
sleep 10
|
||||
docker stack services rose-ash
|
||||
@@ -99,17 +103,17 @@ jobs:
|
||||
fi
|
||||
if [ \"\$SX_REBUILT\" = true ]; then
|
||||
echo 'Deploying sx-web stack (sx-web.org)...'
|
||||
docker stack deploy -c /root/sx-web/docker-compose.yml sx-web
|
||||
docker stack deploy --resolve-image always -c /root/sx-web/docker-compose.yml sx-web
|
||||
sleep 5
|
||||
docker stack services sx-web
|
||||
# Reload Caddy to pick up any Caddyfile changes
|
||||
docker service update --force caddy_caddy 2>/dev/null || true
|
||||
fi
|
||||
else
|
||||
echo 'Skipping swarm deploy (branch: ${{ github.ref_name }})'
|
||||
fi
|
||||
|
||||
# Dev stack always deployed (bind-mounted source + auto-reload)
|
||||
# Dev stack uses working tree (bind-mounted source + auto-reload)
|
||||
cd ${{ env.APP_DIR }}
|
||||
echo 'Deploying dev stack...'
|
||||
docker compose -p rose-ash-dev -f docker-compose.yml -f docker-compose.dev.yml up -d
|
||||
echo 'Dev stack deployed'
|
||||
|
||||
5
.gitignore
vendored
5
.gitignore
vendored
@@ -1,6 +1,7 @@
|
||||
__pycache__/
|
||||
*.pyc
|
||||
*.pyo
|
||||
shared/sx/.cache/
|
||||
.env
|
||||
node_modules/
|
||||
*.egg-info/
|
||||
@@ -10,3 +11,7 @@ build/
|
||||
venv/
|
||||
_snapshot/
|
||||
_debug/
|
||||
sx-haskell/
|
||||
sx-rust/
|
||||
shared/static/scripts/sx-full-test.js
|
||||
hosts/ocaml/_build/
|
||||
|
||||
@@ -5,6 +5,7 @@ Cooperative web platform: federated content, commerce, events, and media process
|
||||
## Deployment
|
||||
|
||||
- **Do NOT push** until explicitly told to. Pushes reload code to dev automatically.
|
||||
- **NEVER push to `main`** — pushing to main triggers a **PRODUCTION deploy**. Only push to main when the user explicitly requests a production deploy. Work on the `macros` branch by default; merge to main only with explicit permission.
|
||||
|
||||
## Project Structure
|
||||
|
||||
|
||||
91
RESTRUCTURE_PLAN.md
Normal file
91
RESTRUCTURE_PLAN.md
Normal file
@@ -0,0 +1,91 @@
|
||||
# Restructure Plan
|
||||
|
||||
Reorganise from flat `shared/sx/ref/` to layered `spec/` + `hosts/` + `web/` + `sx/`.
|
||||
|
||||
Recovery point: commit `1a3d7b3` on branch `macros`.
|
||||
|
||||
## Phase 1: Directory structure
|
||||
Create all directories. No file moves.
|
||||
```
|
||||
spec/tests/
|
||||
hosts/python/
|
||||
hosts/javascript/
|
||||
web/adapters/
|
||||
web/tests/
|
||||
web/platforms/python/
|
||||
web/platforms/javascript/
|
||||
sx/platforms/python/
|
||||
sx/platforms/javascript/
|
||||
```
|
||||
|
||||
## Phase 2: Spec files (git mv)
|
||||
Move from `shared/sx/ref/` to `spec/`:
|
||||
- eval.sx, parser.sx, primitives.sx, render.sx
|
||||
- cek.sx, frames.sx, special-forms.sx
|
||||
- continuations.sx, callcc.sx, types.sx
|
||||
Move tests to `spec/tests/`:
|
||||
- test-framework.sx, test.sx, test-eval.sx, test-parser.sx
|
||||
- test-render.sx, test-cek.sx, test-continuations.sx, test-types.sx
|
||||
Remove boundary-core.sx from spec/ (it's a contract doc, not spec)
|
||||
|
||||
## Phase 3: Host files (git mv)
|
||||
Python host - move from `shared/sx/ref/` to `hosts/python/`:
|
||||
- bootstrap_py.py → hosts/python/bootstrap.py
|
||||
- platform_py.py → hosts/python/platform.py
|
||||
- py.sx → hosts/python/transpiler.sx
|
||||
- boundary_parser.py → hosts/python/boundary_parser.py
|
||||
- run_signal_tests.py, run_cek_tests.py, run_cek_reactive_tests.py,
|
||||
run_continuation_tests.py, run_type_tests.py → hosts/python/tests/
|
||||
|
||||
JS host - move from `shared/sx/ref/` to `hosts/javascript/`:
|
||||
- run_js_sx.py → hosts/javascript/bootstrap.py
|
||||
- bootstrap_js.py → hosts/javascript/cli.py
|
||||
- platform_js.py → hosts/javascript/platform.py
|
||||
- js.sx → hosts/javascript/transpiler.sx
|
||||
|
||||
Generated output stays in place:
|
||||
- shared/sx/ref/sx_ref.py (Python runtime)
|
||||
- shared/static/scripts/sx-browser.js (JS runtime)
|
||||
|
||||
## Phase 4: Web framework files (git mv)
|
||||
Move from `shared/sx/ref/` to `web/`:
|
||||
- signals.sx → web/signals.sx
|
||||
- engine.sx, orchestration.sx, boot.sx → web/
|
||||
- router.sx, deps.sx, forms.sx, page-helpers.sx → web/
|
||||
Move adapters to `web/adapters/`:
|
||||
- adapter-dom.sx → web/adapters/dom.sx
|
||||
- adapter-html.sx → web/adapters/html.sx
|
||||
- adapter-sx.sx → web/adapters/sx.sx
|
||||
- adapter-async.sx → web/adapters/async.sx
|
||||
Move web tests to `web/tests/`:
|
||||
- test-signals.sx, test-aser.sx, test-engine.sx, etc.
|
||||
Move boundary-web.sx to `web/boundary.sx`
|
||||
Move boundary-app.sx to `web/boundary-app.sx`
|
||||
|
||||
## Phase 5: Platform bindings
|
||||
Web platforms:
|
||||
- Extract DOM/browser primitives from platform_js.py → web/platforms/javascript/
|
||||
- Extract IO/server primitives from platform_py.py → web/platforms/python/
|
||||
App platforms:
|
||||
- sx/sxc/pages/helpers.py → sx/platforms/python/helpers.py
|
||||
- sx/sxc/init-client.sx.txt → sx/platforms/javascript/init.sx
|
||||
|
||||
## Phase 6: Update imports
|
||||
- All Python imports referencing shared.sx.ref.*
|
||||
- Bootstrapper paths (ref_dir, _source_dirs, _find_sx)
|
||||
- Docker volume mounts in docker-compose*.yml
|
||||
- Test runner paths
|
||||
- CLAUDE.md paths
|
||||
|
||||
## Phase 7: Verify
|
||||
- Both bootstrappers build
|
||||
- All tests pass
|
||||
- Dev container starts
|
||||
- Website works
|
||||
- Remove duplicate files from shared/sx/ref/
|
||||
|
||||
## Notes
|
||||
- Generated files (sx_ref.py, sx-browser.js) stay where they are
|
||||
- The runtime imports from shared.sx.ref.sx_ref — that doesn't change
|
||||
- Only the SOURCE .sx files and bootstrapper tools move
|
||||
- Each phase is a separate commit for safe rollback
|
||||
86
_config/dev-sh-config.yaml
Normal file
86
_config/dev-sh-config.yaml
Normal file
@@ -0,0 +1,86 @@
|
||||
root: "/rose-ash-wholefood-coop" # no trailing slash needed (we normalize it)
|
||||
host: "https://rose-ash.com"
|
||||
base_host: "wholesale.suma.coop"
|
||||
base_login: https://wholesale.suma.coop/customer/account/login/
|
||||
base_url: https://wholesale.suma.coop/
|
||||
title: sx-web
|
||||
market_root: /market
|
||||
market_title: Market
|
||||
blog_root: /
|
||||
blog_title: all the news
|
||||
cart_root: /cart
|
||||
app_urls:
|
||||
blog: "https://blog.rose-ash.com"
|
||||
market: "https://market.rose-ash.com"
|
||||
cart: "https://cart.rose-ash.com"
|
||||
events: "https://events.rose-ash.com"
|
||||
federation: "https://federation.rose-ash.com"
|
||||
account: "https://account.rose-ash.com"
|
||||
sx: "https://sx.rose-ash.com"
|
||||
test: "https://test.rose-ash.com"
|
||||
orders: "https://orders.rose-ash.com"
|
||||
cache:
|
||||
fs_root: /app/_snapshot # <- absolute path to your snapshot dir
|
||||
categories:
|
||||
allow:
|
||||
Basics: basics
|
||||
Branded Goods: branded-goods
|
||||
Chilled: chilled
|
||||
Frozen: frozen
|
||||
Non-foods: non-foods
|
||||
Supplements: supplements
|
||||
Christmas: christmas
|
||||
slugs:
|
||||
skip:
|
||||
- ""
|
||||
- customer
|
||||
- account
|
||||
- checkout
|
||||
- wishlist
|
||||
- sales
|
||||
- contact
|
||||
- privacy-policy
|
||||
- terms-and-conditions
|
||||
- delivery
|
||||
- catalogsearch
|
||||
- quickorder
|
||||
- apply
|
||||
- search
|
||||
- static
|
||||
- media
|
||||
section-titles:
|
||||
- ingredients
|
||||
- allergy information
|
||||
- allergens
|
||||
- nutritional information
|
||||
- nutrition
|
||||
- storage
|
||||
- directions
|
||||
- preparation
|
||||
- serving suggestions
|
||||
- origin
|
||||
- country of origin
|
||||
- recycling
|
||||
- general information
|
||||
- additional information
|
||||
- a note about prices
|
||||
|
||||
blacklist:
|
||||
category:
|
||||
- branded-goods/alcoholic-drinks
|
||||
- branded-goods/beers
|
||||
- branded-goods/ciders
|
||||
- branded-goods/wines
|
||||
product:
|
||||
- list-price-suma-current-suma-price-list-each-bk012-2-html
|
||||
product-details:
|
||||
- General Information
|
||||
- A Note About Prices
|
||||
sumup:
|
||||
merchant_code: "ME4J6100"
|
||||
currency: "GBP"
|
||||
# Name of the environment variable that holds your SumUp API key
|
||||
api_key_env: "SUMUP_API_KEY"
|
||||
webhook_secret: "jfwlekjfwef798ewf769ew8f679ew8f7weflwef"
|
||||
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
;; Auth page components (device auth — account-specific)
|
||||
;; Login and check-email components are shared: see shared/sx/templates/auth.sx
|
||||
|
||||
(defcomp ~account-device-error (&key error)
|
||||
(defcomp ~auth/device-error (&key (error :as string))
|
||||
(when error
|
||||
(div :class "bg-red-50 border border-red-200 text-red-700 p-3 rounded mb-4"
|
||||
error)))
|
||||
|
||||
(defcomp ~account-device-form (&key error action csrf-token code)
|
||||
(defcomp ~auth/device-form (&key error (action :as string) (csrf-token :as string) (code :as string))
|
||||
(div :class "py-8 max-w-md mx-auto"
|
||||
(h1 :class "text-2xl font-bold mb-6" "Authorize device")
|
||||
(p :class "text-stone-600 mb-4" "Enter the code shown in your terminal to sign in.")
|
||||
@@ -22,30 +22,30 @@
|
||||
:class "w-full bg-stone-800 text-white py-2 px-4 rounded hover:bg-stone-700 transition"
|
||||
"Authorize"))))
|
||||
|
||||
(defcomp ~account-device-approved ()
|
||||
(defcomp ~auth/device-approved ()
|
||||
(div :class "py-8 max-w-md mx-auto text-center"
|
||||
(h1 :class "text-2xl font-bold mb-4" "Device authorized")
|
||||
(p :class "text-stone-600" "You can close this window and return to your terminal.")))
|
||||
|
||||
;; Assembled auth page content — replaces Python _login_page_content etc.
|
||||
|
||||
(defcomp ~account-login-content (&key error email)
|
||||
(~auth-login-form
|
||||
:error (when error (~auth-error-banner :error error))
|
||||
(defcomp ~auth/login-content (&key (error :as string?) (email :as string?))
|
||||
(~shared:auth/login-form
|
||||
:error (when error (~shared:auth/error-banner :error error))
|
||||
:action (url-for "auth.start_login")
|
||||
:csrf-token (csrf-token)
|
||||
:email (or email "")))
|
||||
|
||||
(defcomp ~account-device-content (&key error code)
|
||||
(~account-device-form
|
||||
:error (when error (~account-device-error :error error))
|
||||
(defcomp ~auth/device-content (&key (error :as string?) (code :as string?))
|
||||
(~auth/device-form
|
||||
:error (when error (~auth/device-error :error error))
|
||||
:action (url-for "auth.device_submit")
|
||||
:csrf-token (csrf-token)
|
||||
:code (or code "")))
|
||||
|
||||
(defcomp ~account-check-email-content (&key email email-error)
|
||||
(~auth-check-email
|
||||
(defcomp ~auth/check-email-content (&key (email :as string?) (email-error :as string?))
|
||||
(~shared:auth/check-email
|
||||
:email (escape (or email ""))
|
||||
:error (when email-error
|
||||
(~auth-check-email-error :error (escape email-error)))))
|
||||
(~shared:auth/check-email-error :error (escape email-error)))))
|
||||
|
||||
|
||||
@@ -1,36 +1,36 @@
|
||||
;; Account dashboard components
|
||||
|
||||
(defcomp ~account-error-banner (&key error)
|
||||
(defcomp ~dashboard/error-banner (&key (error :as string))
|
||||
(when error
|
||||
(div :class "rounded-lg border border-red-200 bg-red-50 text-red-800 px-4 py-3 text-sm"
|
||||
error)))
|
||||
|
||||
(defcomp ~account-user-email (&key email)
|
||||
(defcomp ~dashboard/user-email (&key (email :as string))
|
||||
(when email
|
||||
(p :class "text-sm text-stone-500 mt-1" email)))
|
||||
|
||||
(defcomp ~account-user-name (&key name)
|
||||
(defcomp ~dashboard/user-name (&key (name :as string))
|
||||
(when name
|
||||
(p :class "text-sm text-stone-600" name)))
|
||||
|
||||
(defcomp ~account-logout-form (&key csrf-token)
|
||||
(defcomp ~dashboard/logout-form (&key (csrf-token :as string))
|
||||
(form :action "/auth/logout/" :method "post"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf-token)
|
||||
(button :type "submit"
|
||||
:class "inline-flex items-center gap-2 rounded-full border border-stone-300 px-4 py-2 text-sm font-medium text-stone-700 hover:bg-stone-50 transition"
|
||||
(i :class "fa-solid fa-right-from-bracket text-xs") " Sign out")))
|
||||
|
||||
(defcomp ~account-label-item (&key name)
|
||||
(defcomp ~dashboard/label-item (&key (name :as string))
|
||||
(span :class "inline-flex items-center rounded-full border border-stone-200 px-3 py-1 text-xs font-medium bg-white/60"
|
||||
name))
|
||||
|
||||
(defcomp ~account-labels-section (&key items)
|
||||
(defcomp ~dashboard/labels-section (&key items)
|
||||
(when items
|
||||
(div
|
||||
(h2 :class "text-base font-semibold tracking-tight mb-3" "Labels")
|
||||
(div :class "flex flex-wrap gap-2" items))))
|
||||
|
||||
(defcomp ~account-main-panel (&key error email name logout labels)
|
||||
(defcomp ~dashboard/main-panel (&key error email name logout labels)
|
||||
(div :class "w-full max-w-3xl mx-auto px-4 py-6"
|
||||
(div :class "bg-white/70 backdrop-blur rounded-2xl shadow border border-stone-200 p-6 sm:p-8 space-y-8"
|
||||
error
|
||||
@@ -43,18 +43,18 @@
|
||||
labels)))
|
||||
|
||||
;; Assembled dashboard content — replaces Python _account_main_panel_sx
|
||||
(defcomp ~account-dashboard-content (&key error)
|
||||
(defcomp ~dashboard/content (&key (error :as string?))
|
||||
(let* ((user (current-user))
|
||||
(csrf (csrf-token)))
|
||||
(~account-main-panel
|
||||
:error (when error (~account-error-banner :error error))
|
||||
(~dashboard/main-panel
|
||||
:error (when error (~dashboard/error-banner :error error))
|
||||
:email (when (get user "email")
|
||||
(~account-user-email :email (get user "email")))
|
||||
(~dashboard/user-email :email (get user "email")))
|
||||
:name (when (get user "name")
|
||||
(~account-user-name :name (get user "name")))
|
||||
:logout (~account-logout-form :csrf-token csrf)
|
||||
(~dashboard/user-name :name (get user "name")))
|
||||
:logout (~dashboard/logout-form :csrf-token csrf)
|
||||
:labels (when (not (empty? (or (get user "labels") (list))))
|
||||
(~account-labels-section
|
||||
(~dashboard/labels-section
|
||||
:items (map (lambda (label)
|
||||
(~account-label-item :name (get label "name")))
|
||||
(~dashboard/label-item :name (get label "name")))
|
||||
(get user "labels")))))))
|
||||
|
||||
@@ -2,19 +2,19 @@
|
||||
;; Registered via register_sx_layout("account", ...) in __init__.py.
|
||||
|
||||
;; Full page: root header + auth header row in header-child
|
||||
(defcomp ~account-layout-full ()
|
||||
(defcomp ~layouts/full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (~auth-header-row-auto))))
|
||||
|
||||
;; OOB (HTMX): auth row + root header, both with oob=true
|
||||
(defcomp ~account-layout-oob ()
|
||||
(defcomp ~layouts/oob ()
|
||||
(<> (~auth-header-row-auto true)
|
||||
(~root-header-auto true)))
|
||||
|
||||
;; Mobile menu: auth section + root nav
|
||||
(defcomp ~account-layout-mobile ()
|
||||
(<> (~mobile-menu-section
|
||||
(defcomp ~layouts/mobile ()
|
||||
(<> (~shared:layout/mobile-menu-section
|
||||
:label "account" :href "/" :level 1 :colour "sky"
|
||||
:items (~auth-nav-items-auto))
|
||||
(~root-mobile-auto)))
|
||||
|
||||
@@ -1,30 +1,30 @@
|
||||
;; Newsletter management components
|
||||
|
||||
(defcomp ~account-newsletter-desc (&key description)
|
||||
(defcomp ~newsletters/desc (&key (description :as string))
|
||||
(when description
|
||||
(p :class "text-xs text-stone-500 mt-0.5 truncate" description)))
|
||||
|
||||
(defcomp ~account-newsletter-toggle (&key id url hdrs target cls checked knob-cls)
|
||||
(defcomp ~newsletters/toggle (&key (id :as string) (url :as string) (hdrs :as dict) (target :as string) (cls :as string) (checked :as string) (knob-cls :as string))
|
||||
(div :id id :class "flex items-center"
|
||||
(button :sx-post url :sx-headers hdrs :sx-target target :sx-swap "outerHTML"
|
||||
:class cls :role "switch" :aria-checked checked
|
||||
(span :class knob-cls))))
|
||||
|
||||
|
||||
(defcomp ~account-newsletter-item (&key name desc toggle)
|
||||
(defcomp ~newsletters/item (&key (name :as string) desc toggle)
|
||||
(div :class "flex items-center justify-between py-4 first:pt-0 last:pb-0"
|
||||
(div :class "min-w-0 flex-1"
|
||||
(p :class "text-sm font-medium text-stone-800" name)
|
||||
desc)
|
||||
(div :class "ml-4 flex-shrink-0" toggle)))
|
||||
|
||||
(defcomp ~account-newsletter-list (&key items)
|
||||
(defcomp ~newsletters/list (&key items)
|
||||
(div :class "divide-y divide-stone-100" items))
|
||||
|
||||
(defcomp ~account-newsletter-empty ()
|
||||
(defcomp ~newsletters/empty ()
|
||||
(p :class "text-sm text-stone-500" "No newsletters available."))
|
||||
|
||||
(defcomp ~account-newsletters-panel (&key list)
|
||||
(defcomp ~newsletters/panel (&key list)
|
||||
(div :class "w-full max-w-3xl mx-auto px-4 py-6"
|
||||
(div :class "bg-white/70 backdrop-blur rounded-2xl shadow border border-stone-200 p-6 sm:p-8 space-y-6"
|
||||
(h1 :class "text-xl font-semibold tracking-tight" "Newsletters")
|
||||
@@ -32,12 +32,12 @@
|
||||
|
||||
;; Assembled newsletters content — replaces Python _newsletters_panel_sx
|
||||
;; Takes pre-fetched newsletter-list from page helper
|
||||
(defcomp ~account-newsletters-content (&key newsletter-list account-url)
|
||||
(defcomp ~newsletters/content (&key (newsletter-list :as list) (account-url :as string?))
|
||||
(let* ((csrf (csrf-token)))
|
||||
(if (empty? newsletter-list)
|
||||
(~account-newsletter-empty)
|
||||
(~account-newsletters-panel
|
||||
:list (~account-newsletter-list
|
||||
(~newsletters/empty)
|
||||
(~newsletters/panel
|
||||
:list (~newsletters/list
|
||||
:items (map (lambda (item)
|
||||
(let* ((nl (get item "newsletter"))
|
||||
(un (get item "un"))
|
||||
@@ -47,11 +47,11 @@
|
||||
(bg (if subscribed "bg-emerald-500" "bg-stone-300"))
|
||||
(translate (if subscribed "translate-x-6" "translate-x-1"))
|
||||
(checked (if subscribed "true" "false")))
|
||||
(~account-newsletter-item
|
||||
(~newsletters/item
|
||||
:name (get nl "name")
|
||||
:desc (when (get nl "description")
|
||||
(~account-newsletter-desc :description (get nl "description")))
|
||||
:toggle (~account-newsletter-toggle
|
||||
(~newsletters/desc :description (get nl "description")))
|
||||
:toggle (~newsletters/toggle
|
||||
:id (str "nl-" nid)
|
||||
:url toggle-url
|
||||
:hdrs {:X-CSRFToken csrf}
|
||||
|
||||
@@ -8,7 +8,7 @@
|
||||
:path "/"
|
||||
:auth :login
|
||||
:layout :account
|
||||
:content (~account-dashboard-content))
|
||||
:content (~dashboard/content))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Newsletters
|
||||
@@ -19,7 +19,7 @@
|
||||
:auth :login
|
||||
:layout :account
|
||||
:data (service "account-page" "newsletters-data")
|
||||
:content (~account-newsletters-content
|
||||
:content (~newsletters/content
|
||||
:newsletter-list newsletter-list
|
||||
:account-url account-url))
|
||||
|
||||
|
||||
@@ -256,7 +256,7 @@ def _image(node: dict) -> str:
|
||||
parts.append(f':width "{_esc(width)}"')
|
||||
if href:
|
||||
parts.append(f':href "{_esc(href)}"')
|
||||
return "(~kg-image " + " ".join(parts) + ")"
|
||||
return "(~kg_cards/kg-image " + " ".join(parts) + ")"
|
||||
|
||||
|
||||
@_converter("gallery")
|
||||
@@ -282,14 +282,14 @@ def _gallery(node: dict) -> str:
|
||||
images_sx = "(list " + " ".join(rows) + ")"
|
||||
caption = node.get("caption", "")
|
||||
caption_attr = f" :caption {html_to_sx(caption)}" if caption else ""
|
||||
return f"(~kg-gallery :images {images_sx}{caption_attr})"
|
||||
return f"(~kg_cards/kg-gallery :images {images_sx}{caption_attr})"
|
||||
|
||||
|
||||
@_converter("html")
|
||||
def _html_card(node: dict) -> str:
|
||||
raw = node.get("html", "")
|
||||
inner = html_to_sx(raw)
|
||||
return f"(~kg-html {inner})"
|
||||
return f"(~kg_cards/kg-html {inner})"
|
||||
|
||||
|
||||
@_converter("embed")
|
||||
@@ -299,7 +299,7 @@ def _embed(node: dict) -> str:
|
||||
parts = [f':html "{_esc(embed_html)}"']
|
||||
if caption:
|
||||
parts.append(f":caption {html_to_sx(caption)}")
|
||||
return "(~kg-embed " + " ".join(parts) + ")"
|
||||
return "(~kg_cards/kg-embed " + " ".join(parts) + ")"
|
||||
|
||||
|
||||
@_converter("bookmark")
|
||||
@@ -330,7 +330,7 @@ def _bookmark(node: dict) -> str:
|
||||
if caption:
|
||||
parts.append(f":caption {html_to_sx(caption)}")
|
||||
|
||||
return "(~kg-bookmark " + " ".join(parts) + ")"
|
||||
return "(~kg_cards/kg-bookmark " + " ".join(parts) + ")"
|
||||
|
||||
|
||||
@_converter("callout")
|
||||
@@ -344,7 +344,7 @@ def _callout(node: dict) -> str:
|
||||
parts.append(f':emoji "{_esc(emoji)}"')
|
||||
if inner:
|
||||
parts.append(f':content {inner}')
|
||||
return "(~kg-callout " + " ".join(parts) + ")"
|
||||
return "(~kg_cards/kg-callout " + " ".join(parts) + ")"
|
||||
|
||||
|
||||
@_converter("button")
|
||||
@@ -352,7 +352,7 @@ def _button(node: dict) -> str:
|
||||
text = node.get("buttonText", "")
|
||||
url = node.get("buttonUrl", "")
|
||||
alignment = node.get("alignment", "center")
|
||||
return f'(~kg-button :url "{_esc(url)}" :text "{_esc(text)}" :alignment "{_esc(alignment)}")'
|
||||
return f'(~kg_cards/kg-button :url "{_esc(url)}" :text "{_esc(text)}" :alignment "{_esc(alignment)}")'
|
||||
|
||||
|
||||
@_converter("toggle")
|
||||
@@ -360,7 +360,7 @@ def _toggle(node: dict) -> str:
|
||||
heading = node.get("heading", "")
|
||||
inner = _convert_children(node.get("children", []))
|
||||
content_attr = f" :content {inner}" if inner else ""
|
||||
return f'(~kg-toggle :heading "{_esc(heading)}"{content_attr})'
|
||||
return f'(~kg_cards/kg-toggle :heading "{_esc(heading)}"{content_attr})'
|
||||
|
||||
|
||||
@_converter("audio")
|
||||
@@ -380,7 +380,7 @@ def _audio(node: dict) -> str:
|
||||
parts.append(f':duration "{duration_str}"')
|
||||
if thumbnail:
|
||||
parts.append(f':thumbnail "{_esc(thumbnail)}"')
|
||||
return "(~kg-audio " + " ".join(parts) + ")"
|
||||
return "(~kg_cards/kg-audio " + " ".join(parts) + ")"
|
||||
|
||||
|
||||
@_converter("video")
|
||||
@@ -400,7 +400,7 @@ def _video(node: dict) -> str:
|
||||
parts.append(f':thumbnail "{_esc(thumbnail)}"')
|
||||
if loop:
|
||||
parts.append(":loop true")
|
||||
return "(~kg-video " + " ".join(parts) + ")"
|
||||
return "(~kg_cards/kg-video " + " ".join(parts) + ")"
|
||||
|
||||
|
||||
@_converter("file")
|
||||
@@ -429,12 +429,12 @@ def _file(node: dict) -> str:
|
||||
parts.append(f':filesize "{size_str}"')
|
||||
if caption:
|
||||
parts.append(f":caption {html_to_sx(caption)}")
|
||||
return "(~kg-file " + " ".join(parts) + ")"
|
||||
return "(~kg_cards/kg-file " + " ".join(parts) + ")"
|
||||
|
||||
|
||||
@_converter("paywall")
|
||||
def _paywall(_node: dict) -> str:
|
||||
return "(~kg-paywall)"
|
||||
return "(~kg_cards/kg-paywall)"
|
||||
|
||||
|
||||
@_converter("markdown")
|
||||
@@ -442,4 +442,4 @@ def _markdown(node: dict) -> str:
|
||||
md_text = node.get("markdown", "")
|
||||
rendered = mistune.html(md_text)
|
||||
inner = html_to_sx(rendered)
|
||||
return f"(~kg-md {inner})"
|
||||
return f"(~kg_cards/kg-md {inner})"
|
||||
|
||||
@@ -1,10 +1,10 @@
|
||||
#!/usr/bin/env python3
|
||||
"""
|
||||
Re-convert sx_content from lexical JSON to eliminate ~kg-html wrappers and
|
||||
Re-convert sx_content from lexical JSON to eliminate ~kg_cards/kg-html wrappers and
|
||||
raw caption strings.
|
||||
|
||||
The updated lexical_to_sx converter now produces native sx expressions instead
|
||||
of (1) wrapping HTML/markdown cards in (~kg-html :html "...") and (2) storing
|
||||
of (1) wrapping HTML/markdown cards in (~kg_cards/kg-html :html "...") and (2) storing
|
||||
captions as escaped HTML strings. This script re-runs the conversion on all
|
||||
posts that already have sx_content, overwriting the old output.
|
||||
|
||||
@@ -50,11 +50,11 @@ async def migrate(dry_run: bool = False) -> int:
|
||||
continue
|
||||
|
||||
if dry_run:
|
||||
old_has_kg = "~kg-html" in (post.sx_content or "")
|
||||
old_has_kg = "~kg_cards/kg-html" in (post.sx_content or "")
|
||||
old_has_raw = "raw! caption" in (post.sx_content or "")
|
||||
markers = []
|
||||
if old_has_kg:
|
||||
markers.append("~kg-html")
|
||||
markers.append("~kg_cards/kg-html")
|
||||
if old_has_raw:
|
||||
markers.append("raw-caption")
|
||||
tag = f" [{', '.join(markers)}]" if markers else ""
|
||||
@@ -76,7 +76,7 @@ async def migrate(dry_run: bool = False) -> int:
|
||||
|
||||
def main():
|
||||
parser = argparse.ArgumentParser(
|
||||
description="Re-convert sx_content to eliminate ~kg-html and raw captions"
|
||||
description="Re-convert sx_content to eliminate ~kg_cards/kg-html and raw captions"
|
||||
)
|
||||
parser.add_argument("--dry-run", action="store_true",
|
||||
help="Preview changes without writing to database")
|
||||
|
||||
@@ -398,7 +398,7 @@ class BlogPageService:
|
||||
}
|
||||
|
||||
def post_detail_data(self, post, user, rights, csrf, blog_url_base):
|
||||
"""Serialize post detail view data for ~blog-post-detail-content defcomp."""
|
||||
"""Serialize post detail view data for ~detail/post-detail-content defcomp."""
|
||||
slug = post.get("slug", "")
|
||||
is_admin = rights.get("admin") if isinstance(rights, dict) else getattr(rights, "admin", False)
|
||||
user_id = getattr(user, "id", None) if user else None
|
||||
|
||||
234
blog/sx/admin.sx
234
blog/sx/admin.sx
@@ -1,6 +1,6 @@
|
||||
;; Blog admin panel components
|
||||
|
||||
(defcomp ~blog-cache-panel (&key clear-url csrf)
|
||||
(defcomp ~admin/cache-panel (&key (clear-url :as string) (csrf :as string))
|
||||
(div :class "max-w-2xl mx-auto px-4 py-6 space-y-6"
|
||||
(div :class "flex flex-col md:flex-row gap-3 items-start"
|
||||
(form :sx-post clear-url :sx-trigger "submit" :sx-target "#cache-status" :sx-swap "innerHTML"
|
||||
@@ -8,21 +8,21 @@
|
||||
(button :class "border rounded px-4 py-2 bg-stone-800 text-white text-sm" :type "submit" "Clear cache"))
|
||||
(div :id "cache-status" :class "py-2"))))
|
||||
|
||||
(defcomp ~blog-snippets-panel (&key list)
|
||||
(defcomp ~admin/snippets-panel (&key list)
|
||||
(div :class "max-w-4xl mx-auto p-6"
|
||||
(div :class "mb-6 flex justify-between items-center"
|
||||
(h1 :class "text-3xl font-bold" "Snippets"))
|
||||
(div :id "snippets-list" list)))
|
||||
|
||||
(defcomp ~blog-snippet-visibility-select (&key patch-url hx-headers options cls)
|
||||
(defcomp ~admin/snippet-visibility-select (&key patch-url hx-headers options cls)
|
||||
(select :name "visibility" :sx-patch patch-url :sx-target "#snippets-list" :sx-swap "innerHTML"
|
||||
:sx-headers hx-headers :class "text-sm border border-stone-300 rounded px-2 py-1"
|
||||
options))
|
||||
|
||||
(defcomp ~blog-snippet-option (&key value selected label)
|
||||
(defcomp ~admin/snippet-option (&key (value :as string) (selected :as boolean) (label :as string))
|
||||
(option :value value :selected selected label))
|
||||
|
||||
(defcomp ~blog-snippet-row (&key name owner badge-cls visibility extra)
|
||||
(defcomp ~admin/snippet-row (&key (name :as string) (owner :as string) (badge-cls :as string) (visibility :as string) extra)
|
||||
(div :class "flex items-center gap-4 p-4 hover:bg-stone-50 transition"
|
||||
(div :class "flex-1 min-w-0"
|
||||
(div :class "font-medium truncate" name)
|
||||
@@ -30,10 +30,10 @@
|
||||
(span :class (str "inline-flex items-center px-2.5 py-0.5 rounded-full text-xs font-medium " badge-cls) visibility)
|
||||
extra))
|
||||
|
||||
(defcomp ~blog-snippets-list (&key rows)
|
||||
(defcomp ~admin/snippets-list (&key rows)
|
||||
(div :class "bg-white rounded-lg shadow" (div :class "divide-y" rows)))
|
||||
|
||||
(defcomp ~blog-menu-items-panel (&key new-url list)
|
||||
(defcomp ~admin/menu-items-panel (&key new-url list)
|
||||
(div :class "max-w-4xl mx-auto p-6"
|
||||
(div :class "mb-6 flex justify-end items-center"
|
||||
(button :type "button" :sx-get new-url :sx-target "#menu-item-form" :sx-swap "innerHTML"
|
||||
@@ -42,7 +42,7 @@
|
||||
(div :id "menu-item-form" :class "mb-6")
|
||||
(div :id "menu-items-list" list)))
|
||||
|
||||
(defcomp ~blog-menu-item-row (&key img label slug sort-order edit-url delete-url confirm-text hx-headers)
|
||||
(defcomp ~admin/menu-item-row (&key img (label :as string) (slug :as string) (sort-order :as string) (edit-url :as string) (delete-url :as string) (confirm-text :as string) hx-headers)
|
||||
(div :class "flex items-center gap-4 p-4 hover:bg-stone-50 transition"
|
||||
(div :class "text-stone-400 cursor-move" (i :class "fa fa-grip-vertical"))
|
||||
img
|
||||
@@ -54,16 +54,16 @@
|
||||
(button :type "button" :sx-get edit-url :sx-target "#menu-item-form" :sx-swap "innerHTML"
|
||||
:class "px-3 py-1 text-sm bg-stone-200 hover:bg-stone-300 rounded"
|
||||
(i :class "fa fa-edit") " Edit")
|
||||
(~delete-btn :url delete-url :trigger-target "#menu-items-list"
|
||||
(~shared:misc/delete-btn :url delete-url :trigger-target "#menu-items-list"
|
||||
:title "Delete menu item?" :text confirm-text
|
||||
:sx-headers hx-headers))))
|
||||
|
||||
(defcomp ~blog-menu-items-list (&key rows)
|
||||
(defcomp ~admin/menu-items-list (&key rows)
|
||||
(div :class "bg-white rounded-lg shadow" (div :class "divide-y" rows)))
|
||||
|
||||
;; Tag groups admin
|
||||
|
||||
(defcomp ~blog-tag-groups-create-form (&key create-url csrf)
|
||||
(defcomp ~admin/tag-groups-create-form (&key create-url csrf)
|
||||
(form :method "post" :action create-url :class "border rounded p-4 bg-white space-y-3"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(h3 :class "text-sm font-semibold text-stone-700" "New Group")
|
||||
@@ -74,14 +74,14 @@
|
||||
(input :type "text" :name "feature_image" :placeholder "Image URL (optional)" :class "w-full border rounded px-3 py-2 text-sm")
|
||||
(button :type "submit" :class "border rounded px-4 py-2 bg-stone-800 text-white text-sm" "Create")))
|
||||
|
||||
(defcomp ~blog-tag-group-icon-image (&key src name)
|
||||
(defcomp ~admin/tag-group-icon-image (&key src name)
|
||||
(img :src src :alt name :class "h-8 w-8 rounded-full object-cover border border-stone-300 flex-shrink-0"))
|
||||
|
||||
(defcomp ~blog-tag-group-icon-color (&key style initial)
|
||||
(defcomp ~admin/tag-group-icon-color (&key style initial)
|
||||
(div :class "h-8 w-8 rounded-full text-xs font-semibold flex items-center justify-center border border-stone-300 flex-shrink-0"
|
||||
:style style initial))
|
||||
|
||||
(defcomp ~blog-tag-group-li (&key icon edit-href name slug sort-order)
|
||||
(defcomp ~admin/tag-group-li (&key icon (edit-href :as string) (name :as string) (slug :as string) (sort-order :as number))
|
||||
(li :class "border rounded p-3 bg-white flex items-center gap-3"
|
||||
icon
|
||||
(div :class "flex-1"
|
||||
@@ -89,32 +89,32 @@
|
||||
(span :class "text-xs text-stone-500 ml-2" slug))
|
||||
(span :class "text-xs text-stone-500" (str "order: " sort-order))))
|
||||
|
||||
(defcomp ~blog-tag-groups-list (&key items)
|
||||
(defcomp ~admin/tag-groups-list (&key items)
|
||||
(ul :class "space-y-2" items))
|
||||
|
||||
(defcomp ~blog-unassigned-tag (&key name)
|
||||
(defcomp ~admin/unassigned-tag (&key name)
|
||||
(span :class "inline-block bg-stone-100 text-stone-600 px-2 py-1 text-xs font-medium border border-stone-200 rounded" name))
|
||||
|
||||
(defcomp ~blog-unassigned-tags (&key heading spans)
|
||||
(defcomp ~admin/unassigned-tags (&key heading spans)
|
||||
(div :class "border-t pt-4"
|
||||
(h3 :class "text-sm font-semibold text-stone-700 mb-2" heading)
|
||||
(div :class "flex flex-wrap gap-2" spans)))
|
||||
|
||||
(defcomp ~blog-tag-groups-main (&key form groups unassigned)
|
||||
(defcomp ~admin/tag-groups-main (&key form groups unassigned)
|
||||
(div :class "max-w-2xl mx-auto px-4 py-6 space-y-8"
|
||||
form groups unassigned))
|
||||
|
||||
;; Tag group edit
|
||||
|
||||
(defcomp ~blog-tag-checkbox (&key tag-id checked img name)
|
||||
(defcomp ~admin/tag-checkbox (&key (tag-id :as string) (checked :as boolean) img (name :as string))
|
||||
(label :class "flex items-center gap-2 px-2 py-1 hover:bg-stone-50 rounded text-sm cursor-pointer"
|
||||
(input :type "checkbox" :name "tag_ids" :value tag-id :checked checked :class "rounded border-stone-300")
|
||||
img (span name)))
|
||||
|
||||
(defcomp ~blog-tag-checkbox-image (&key src)
|
||||
(defcomp ~admin/tag-checkbox-image (&key src)
|
||||
(img :src src :alt "" :class "h-4 w-4 rounded-full object-cover"))
|
||||
|
||||
(defcomp ~blog-tag-group-edit-form (&key save-url csrf name colour sort-order feature-image tags)
|
||||
(defcomp ~admin/tag-group-edit-form (&key (save-url :as string) (csrf :as string) (name :as string) (colour :as string?) (sort-order :as number) (feature-image :as string?) tags)
|
||||
(form :method "post" :action save-url :class "border rounded p-4 bg-white space-y-4"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(div :class "space-y-3"
|
||||
@@ -133,19 +133,19 @@
|
||||
(div :class "flex gap-3"
|
||||
(button :type "submit" :class "border rounded px-4 py-2 bg-stone-800 text-white text-sm" "Save"))))
|
||||
|
||||
(defcomp ~blog-tag-group-delete-form (&key delete-url csrf)
|
||||
(defcomp ~admin/tag-group-delete-form (&key (delete-url :as string) (csrf :as string))
|
||||
(form :method "post" :action delete-url :class "border-t pt-4"
|
||||
:onsubmit "return confirm('Delete this tag group? Tags will not be deleted.')"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit" :class "border rounded px-4 py-2 bg-red-600 text-white text-sm" "Delete Group")))
|
||||
|
||||
(defcomp ~blog-tag-group-edit-main (&key edit-form delete-form)
|
||||
(defcomp ~admin/tag-group-edit-main (&key edit-form delete-form)
|
||||
(div :class "max-w-2xl mx-auto px-4 py-6 space-y-6"
|
||||
edit-form delete-form))
|
||||
|
||||
;; Data-driven snippets list (replaces Python _snippets_sx loop)
|
||||
(defcomp ~blog-snippets-from-data (&key snippets user-id is-admin csrf badge-colours)
|
||||
(~blog-snippets-list
|
||||
(defcomp ~admin/snippets-from-data (&key snippets user-id is-admin csrf badge-colours)
|
||||
(~admin/snippets-list
|
||||
:rows (<> (map (lambda (s)
|
||||
(let* ((s-id (get s "id"))
|
||||
(s-name (get s "name"))
|
||||
@@ -155,31 +155,31 @@
|
||||
(badge-cls (or (get badge-colours s-vis) "bg-stone-200 text-stone-700"))
|
||||
(extra (<>
|
||||
(when is-admin
|
||||
(~blog-snippet-visibility-select
|
||||
(~admin/snippet-visibility-select
|
||||
:patch-url (get s "patch_url")
|
||||
:hx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")
|
||||
:options (<>
|
||||
(~blog-snippet-option :value "private" :selected (= s-vis "private") :label "private")
|
||||
(~blog-snippet-option :value "shared" :selected (= s-vis "shared") :label "shared")
|
||||
(~blog-snippet-option :value "admin" :selected (= s-vis "admin") :label "admin"))
|
||||
(~admin/snippet-option :value "private" :selected (= s-vis "private") :label "private")
|
||||
(~admin/snippet-option :value "shared" :selected (= s-vis "shared") :label "shared")
|
||||
(~admin/snippet-option :value "admin" :selected (= s-vis "admin") :label "admin"))
|
||||
:cls "text-sm border border-stone-300 rounded px-2 py-1"))
|
||||
(when (or (= s-uid user-id) is-admin)
|
||||
(~delete-btn :url (get s "delete_url") :trigger-target "#snippets-list"
|
||||
(~shared:misc/delete-btn :url (get s "delete_url") :trigger-target "#snippets-list"
|
||||
:title "Delete snippet?"
|
||||
:text (str "Delete \u201c" s-name "\u201d?")
|
||||
:sx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")
|
||||
:cls "px-3 py-1 text-sm bg-red-200 hover:bg-red-300 rounded text-red-800 flex-shrink-0")))))
|
||||
(~blog-snippet-row :name s-name :owner owner :badge-cls badge-cls
|
||||
(~admin/snippet-row :name s-name :owner owner :badge-cls badge-cls
|
||||
:visibility s-vis :extra extra)))
|
||||
(or snippets (list))))))
|
||||
|
||||
;; Data-driven menu items list (replaces Python _menu_items_list_sx loop)
|
||||
(defcomp ~blog-menu-items-from-data (&key items csrf)
|
||||
(~blog-menu-items-list
|
||||
(defcomp ~admin/menu-items-from-data (&key items csrf)
|
||||
(~admin/menu-items-list
|
||||
:rows (<> (map (lambda (item)
|
||||
(let* ((img (~img-or-placeholder :src (get item "feature_image") :alt (get item "label")
|
||||
(let* ((img (~shared:misc/img-or-placeholder :src (get item "feature_image") :alt (get item "label")
|
||||
:size-cls "w-12 h-12 rounded-full object-cover flex-shrink-0")))
|
||||
(~blog-menu-item-row
|
||||
(~admin/menu-item-row
|
||||
:img img :label (get item "label") :slug (get item "slug")
|
||||
:sort-order (get item "sort_order") :edit-url (get item "edit_url")
|
||||
:delete-url (get item "delete_url")
|
||||
@@ -188,38 +188,38 @@
|
||||
(or items (list))))))
|
||||
|
||||
;; Data-driven tag groups main (replaces Python _tag_groups_main_panel_sx loops)
|
||||
(defcomp ~blog-tag-groups-from-data (&key groups unassigned-tags csrf create-url)
|
||||
(~blog-tag-groups-main
|
||||
:form (~blog-tag-groups-create-form :create-url create-url :csrf csrf)
|
||||
(defcomp ~admin/tag-groups-from-data (&key groups unassigned-tags csrf create-url)
|
||||
(~admin/tag-groups-main
|
||||
:form (~admin/tag-groups-create-form :create-url create-url :csrf csrf)
|
||||
:groups (if (empty? (or groups (list)))
|
||||
(~empty-state :message "No tag groups yet." :cls "text-stone-500 text-sm")
|
||||
(~blog-tag-groups-list
|
||||
(~shared:misc/empty-state :message "No tag groups yet." :cls "text-stone-500 text-sm")
|
||||
(~admin/tag-groups-list
|
||||
:items (<> (map (lambda (g)
|
||||
(let* ((icon (if (get g "feature_image")
|
||||
(~blog-tag-group-icon-image :src (get g "feature_image") :name (get g "name"))
|
||||
(~blog-tag-group-icon-color :style (get g "style") :initial (get g "initial")))))
|
||||
(~blog-tag-group-li :icon icon :edit-href (get g "edit_href")
|
||||
(~admin/tag-group-icon-image :src (get g "feature_image") :name (get g "name"))
|
||||
(~admin/tag-group-icon-color :style (get g "style") :initial (get g "initial")))))
|
||||
(~admin/tag-group-li :icon icon :edit-href (get g "edit_href")
|
||||
:name (get g "name") :slug (get g "slug") :sort-order (get g "sort_order"))))
|
||||
groups))))
|
||||
:unassigned (when (not (empty? (or unassigned-tags (list))))
|
||||
(~blog-unassigned-tags
|
||||
(~admin/unassigned-tags
|
||||
:heading (str "Unassigned Tags (" (len unassigned-tags) ")")
|
||||
:spans (<> (map (lambda (t)
|
||||
(~blog-unassigned-tag :name (get t "name")))
|
||||
(~admin/unassigned-tag :name (get t "name")))
|
||||
unassigned-tags))))))
|
||||
|
||||
;; Data-driven tag group edit (replaces Python _tag_groups_edit_main_panel_sx loop)
|
||||
(defcomp ~blog-tag-checkboxes-from-data (&key tags)
|
||||
(defcomp ~admin/tag-checkboxes-from-data (&key tags)
|
||||
(<> (map (lambda (t)
|
||||
(~blog-tag-checkbox
|
||||
(~admin/tag-checkbox
|
||||
:tag-id (get t "tag_id") :checked (get t "checked")
|
||||
:img (when (get t "feature_image") (~blog-tag-checkbox-image :src (get t "feature_image")))
|
||||
:img (when (get t "feature_image") (~admin/tag-checkbox-image :src (get t "feature_image")))
|
||||
:name (get t "name")))
|
||||
(or tags (list)))))
|
||||
|
||||
;; Preview panel components
|
||||
|
||||
(defcomp ~blog-preview-panel (&key sections)
|
||||
(defcomp ~admin/preview-panel (&key sections)
|
||||
(div :class "max-w-4xl mx-auto px-4 py-6 space-y-4"
|
||||
(style "
|
||||
.sx-pretty, .json-pretty { font-family: monospace; font-size: 12px; line-height: 1.6; white-space: pre-wrap; }
|
||||
@@ -239,18 +239,18 @@
|
||||
")
|
||||
sections))
|
||||
|
||||
(defcomp ~blog-preview-section (&key title content)
|
||||
(defcomp ~admin/preview-section (&key title content)
|
||||
(details :class "border rounded bg-white"
|
||||
(summary :class "cursor-pointer px-4 py-3 font-medium text-sm bg-stone-100 hover:bg-stone-200 select-none" title)
|
||||
(div :class "p-4 overflow-x-auto text-xs" content)))
|
||||
|
||||
(defcomp ~blog-preview-rendered (&key html)
|
||||
(defcomp ~admin/preview-rendered (&key html)
|
||||
(div :class "blog-content prose max-w-none" (raw! html)))
|
||||
|
||||
(defcomp ~blog-preview-empty ()
|
||||
(defcomp ~admin/preview-empty ()
|
||||
(div :class "p-8 text-stone-500" "No content to preview."))
|
||||
|
||||
(defcomp ~blog-admin-placeholder ()
|
||||
(defcomp ~admin/placeholder ()
|
||||
(div :class "pb-8"))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
@@ -258,12 +258,12 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Snippets — receives serialized snippet dicts from service
|
||||
(defcomp ~blog-snippets-content (&key snippets is-admin csrf)
|
||||
(~blog-snippets-panel
|
||||
(defcomp ~admin/snippets-content (&key snippets is-admin csrf)
|
||||
(~admin/snippets-panel
|
||||
:list (if (empty? (or snippets (list)))
|
||||
(~empty-state :icon "fa fa-puzzle-piece"
|
||||
(~shared:misc/empty-state :icon "fa fa-puzzle-piece"
|
||||
:message "No snippets yet. Create one from the blog editor.")
|
||||
(~blog-snippets-list
|
||||
(~admin/snippets-list
|
||||
:rows (map (lambda (s)
|
||||
(let* ((badge-colours (dict
|
||||
"private" "bg-stone-200 text-stone-700"
|
||||
@@ -274,19 +274,19 @@
|
||||
(name (get s "name"))
|
||||
(owner (get s "owner"))
|
||||
(can-delete (get s "can_delete")))
|
||||
(~blog-snippet-row
|
||||
(~admin/snippet-row
|
||||
:name name :owner owner :badge-cls badge-cls :visibility vis
|
||||
:extra (<>
|
||||
(when is-admin
|
||||
(~blog-snippet-visibility-select
|
||||
(~admin/snippet-visibility-select
|
||||
:patch-url (get s "patch_url")
|
||||
:hx-headers {:X-CSRFToken csrf}
|
||||
:options (<>
|
||||
(~blog-snippet-option :value "private" :selected (= vis "private") :label "private")
|
||||
(~blog-snippet-option :value "shared" :selected (= vis "shared") :label "shared")
|
||||
(~blog-snippet-option :value "admin" :selected (= vis "admin") :label "admin"))))
|
||||
(~admin/snippet-option :value "private" :selected (= vis "private") :label "private")
|
||||
(~admin/snippet-option :value "shared" :selected (= vis "shared") :label "shared")
|
||||
(~admin/snippet-option :value "admin" :selected (= vis "admin") :label "admin"))))
|
||||
(when can-delete
|
||||
(~delete-btn
|
||||
(~shared:misc/delete-btn
|
||||
:url (get s "delete_url")
|
||||
:trigger-target "#snippets-list"
|
||||
:title "Delete snippet?"
|
||||
@@ -296,16 +296,16 @@
|
||||
(or snippets (list)))))))
|
||||
|
||||
;; Menu Items — receives serialized menu item dicts from service
|
||||
(defcomp ~blog-menu-items-content (&key menu-items new-url csrf)
|
||||
(~blog-menu-items-panel
|
||||
(defcomp ~admin/menu-items-content (&key menu-items new-url csrf)
|
||||
(~admin/menu-items-panel
|
||||
:new-url new-url
|
||||
:list (if (empty? (or menu-items (list)))
|
||||
(~empty-state :icon "fa fa-inbox"
|
||||
(~shared:misc/empty-state :icon "fa fa-inbox"
|
||||
:message "No menu items yet. Add one to get started!")
|
||||
(~blog-menu-items-list
|
||||
(~admin/menu-items-list
|
||||
:rows (map (lambda (mi)
|
||||
(~blog-menu-item-row
|
||||
:img (~img-or-placeholder
|
||||
(~admin/menu-item-row
|
||||
:img (~shared:misc/img-or-placeholder
|
||||
:src (get mi "feature_image") :alt (get mi "label")
|
||||
:size-cls "w-12 h-12 rounded-full object-cover flex-shrink-0")
|
||||
:label (get mi "label")
|
||||
@@ -318,23 +318,23 @@
|
||||
(or menu-items (list)))))))
|
||||
|
||||
;; Tag Groups — receives serialized tag group data from service
|
||||
(defcomp ~blog-tag-groups-content (&key groups unassigned-tags create-url csrf)
|
||||
(~blog-tag-groups-main
|
||||
:form (~blog-tag-groups-create-form :create-url create-url :csrf csrf)
|
||||
(defcomp ~admin/tag-groups-content (&key groups unassigned-tags create-url csrf)
|
||||
(~admin/tag-groups-main
|
||||
:form (~admin/tag-groups-create-form :create-url create-url :csrf csrf)
|
||||
:groups (if (empty? (or groups (list)))
|
||||
(~empty-state :icon "fa fa-tags" :message "No tag groups yet.")
|
||||
(~blog-tag-groups-list
|
||||
(~shared:misc/empty-state :icon "fa fa-tags" :message "No tag groups yet.")
|
||||
(~admin/tag-groups-list
|
||||
:items (map (lambda (g)
|
||||
(let* ((fi (get g "feature_image"))
|
||||
(colour (get g "colour"))
|
||||
(name (get g "name"))
|
||||
(initial (slice (or name "?") 0 1))
|
||||
(icon (if fi
|
||||
(~blog-tag-group-icon-image :src fi :name name)
|
||||
(~blog-tag-group-icon-color
|
||||
(~admin/tag-group-icon-image :src fi :name name)
|
||||
(~admin/tag-group-icon-color
|
||||
:style (if colour (str "background:" colour) "background:#e7e5e4")
|
||||
:initial initial))))
|
||||
(~blog-tag-group-li
|
||||
(~admin/tag-group-li
|
||||
:icon icon
|
||||
:edit-href (get g "edit_href")
|
||||
:name name
|
||||
@@ -342,57 +342,57 @@
|
||||
:sort-order (or (get g "sort_order") 0))))
|
||||
(or groups (list)))))
|
||||
:unassigned (when (not (empty? (or unassigned-tags (list))))
|
||||
(~blog-unassigned-tags
|
||||
(~admin/unassigned-tags
|
||||
:heading (str (len (or unassigned-tags (list))) " Unassigned Tags")
|
||||
:spans (map (lambda (t)
|
||||
(~blog-unassigned-tag :name (get t "name")))
|
||||
(~admin/unassigned-tag :name (get t "name")))
|
||||
(or unassigned-tags (list)))))))
|
||||
|
||||
;; Tag Group Edit — receives serialized tag group + tags from service
|
||||
(defcomp ~blog-tag-group-edit-content (&key group all-tags save-url delete-url csrf)
|
||||
(~blog-tag-group-edit-main
|
||||
:edit-form (~blog-tag-group-edit-form
|
||||
(defcomp ~admin/tag-group-edit-content (&key group all-tags save-url delete-url csrf)
|
||||
(~admin/tag-group-edit-main
|
||||
:edit-form (~admin/tag-group-edit-form
|
||||
:save-url save-url :csrf csrf
|
||||
:name (get group "name")
|
||||
:colour (get group "colour")
|
||||
:sort-order (get group "sort_order")
|
||||
:feature-image (get group "feature_image")
|
||||
:tags (map (lambda (t)
|
||||
(~blog-tag-checkbox
|
||||
(~admin/tag-checkbox
|
||||
:tag-id (get t "id")
|
||||
:checked (get t "checked")
|
||||
:img (when (get t "feature_image")
|
||||
(~blog-tag-checkbox-image :src (get t "feature_image")))
|
||||
(~admin/tag-checkbox-image :src (get t "feature_image")))
|
||||
:name (get t "name")))
|
||||
(or all-tags (list))))
|
||||
:delete-form (~blog-tag-group-delete-form :delete-url delete-url :csrf csrf)))
|
||||
:delete-form (~admin/tag-group-delete-form :delete-url delete-url :csrf csrf)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Preview content composition — replaces _h_post_preview_content
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-preview-content (&key sx-pretty json-pretty sx-rendered lex-rendered)
|
||||
(defcomp ~admin/preview-content (&key sx-pretty json-pretty sx-rendered lex-rendered)
|
||||
(let* ((sections (list)))
|
||||
(if (and (not sx-pretty) (not json-pretty) (not sx-rendered) (not lex-rendered))
|
||||
(~blog-preview-empty)
|
||||
(~blog-preview-panel :sections
|
||||
(~admin/preview-empty)
|
||||
(~admin/preview-panel :sections
|
||||
(<>
|
||||
(when sx-pretty
|
||||
(~blog-preview-section :title "S-Expression Source" :content sx-pretty))
|
||||
(~admin/preview-section :title "S-Expression Source" :content sx-pretty))
|
||||
(when json-pretty
|
||||
(~blog-preview-section :title "Lexical JSON" :content json-pretty))
|
||||
(~admin/preview-section :title "Lexical JSON" :content json-pretty))
|
||||
(when sx-rendered
|
||||
(~blog-preview-section :title "SX Rendered"
|
||||
:content (~blog-preview-rendered :html sx-rendered)))
|
||||
(~admin/preview-section :title "SX Rendered"
|
||||
:content (~admin/preview-rendered :html sx-rendered)))
|
||||
(when lex-rendered
|
||||
(~blog-preview-section :title "Lexical Rendered"
|
||||
:content (~blog-preview-rendered :html lex-rendered))))))))
|
||||
(~admin/preview-section :title "Lexical Rendered"
|
||||
:content (~admin/preview-rendered :html lex-rendered))))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Data introspection composition — replaces _h_post_data_content
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-data-value-cell (&key value value-type)
|
||||
(defcomp ~admin/data-value-cell (&key value value-type)
|
||||
(if (= value-type "nil")
|
||||
(span :class "text-neutral-400" "\u2014")
|
||||
(pre :class "whitespace-pre-wrap break-words break-all text-xs"
|
||||
@@ -400,7 +400,7 @@
|
||||
(code value)
|
||||
value))))
|
||||
|
||||
(defcomp ~blog-data-scalar-table (&key columns)
|
||||
(defcomp ~admin/data-scalar-table (&key columns)
|
||||
(div :class "w-full overflow-x-auto sm:overflow-visible"
|
||||
(table :class "w-full table-fixed text-sm border border-neutral-200 rounded-xl overflow-hidden"
|
||||
(thead :class "bg-neutral-50/70"
|
||||
@@ -411,10 +411,10 @@
|
||||
(tr :class "border-t border-neutral-200 align-top"
|
||||
(td :class "px-3 py-2 whitespace-nowrap text-neutral-600 align-top" (get col "key"))
|
||||
(td :class "px-3 py-2 align-top"
|
||||
(~blog-data-value-cell :value (get col "value") :value-type (get col "type")))))
|
||||
(~admin/data-value-cell :value (get col "value") :value-type (get col "type")))))
|
||||
(or columns (list)))))))
|
||||
|
||||
(defcomp ~blog-data-relationship-item (&key index summary children)
|
||||
(defcomp ~admin/data-relationship-item (&key index summary children)
|
||||
(tr :class "border-t border-neutral-200 align-top"
|
||||
(td :class "px-2 py-1 whitespace-nowrap align-top" (str index))
|
||||
(td :class "px-2 py-1 align-top"
|
||||
@@ -422,11 +422,11 @@
|
||||
(code summary))
|
||||
(when children
|
||||
(div :class "mt-2 pl-3 border-l border-neutral-200"
|
||||
(~blog-data-model-content
|
||||
(~admin/data-model-content
|
||||
:columns (get children "columns")
|
||||
:relationships (get children "relationships")))))))
|
||||
|
||||
(defcomp ~blog-data-relationship (&key name cardinality class-name loaded value)
|
||||
(defcomp ~admin/data-relationship (&key name cardinality class-name loaded value)
|
||||
(div :class "rounded-xl border border-neutral-200"
|
||||
(div :class "px-3 py-2 bg-neutral-50/70 text-sm font-medium"
|
||||
"Relationship: " (span :class "font-semibold" name)
|
||||
@@ -448,7 +448,7 @@
|
||||
(th :class "px-2 py-1 text-left" "Summary")))
|
||||
(tbody
|
||||
(map (lambda (item)
|
||||
(~blog-data-relationship-item
|
||||
(~admin/data-relationship-item
|
||||
:index (get item "index")
|
||||
:summary (get item "summary")
|
||||
:children (get item "children")))
|
||||
@@ -459,17 +459,17 @@
|
||||
(code (get value "summary")))
|
||||
(when (get value "children")
|
||||
(div :class "pl-3 border-l border-neutral-200"
|
||||
(~blog-data-model-content
|
||||
(~admin/data-model-content
|
||||
:columns (get (get value "children") "columns")
|
||||
:relationships (get (get value "children") "relationships"))))))))))
|
||||
|
||||
(defcomp ~blog-data-model-content (&key columns relationships)
|
||||
(defcomp ~admin/data-model-content (&key columns relationships)
|
||||
(div :class "space-y-4"
|
||||
(~blog-data-scalar-table :columns columns)
|
||||
(~admin/data-scalar-table :columns columns)
|
||||
(when (not (empty? (or relationships (list))))
|
||||
(div :class "space-y-3"
|
||||
(map (lambda (rel)
|
||||
(~blog-data-relationship
|
||||
(~admin/data-relationship
|
||||
:name (get rel "name")
|
||||
:cardinality (get rel "cardinality")
|
||||
:class-name (get rel "class_name")
|
||||
@@ -477,13 +477,13 @@
|
||||
:value (get rel "value")))
|
||||
relationships)))))
|
||||
|
||||
(defcomp ~blog-data-table-content (&key tablename model-data)
|
||||
(defcomp ~admin/data-table-content (&key tablename model-data)
|
||||
(if (not model-data)
|
||||
(div :class "px-4 py-8 text-stone-400" "No post data available.")
|
||||
(div :class "px-4 py-8"
|
||||
(div :class "mb-6 text-sm text-neutral-500"
|
||||
"Model: " (code "Post") " \u2022 Table: " (code tablename))
|
||||
(~blog-data-model-content
|
||||
(~admin/data-model-content
|
||||
:columns (get model-data "columns")
|
||||
:relationships (get model-data "relationships")))))
|
||||
|
||||
@@ -491,7 +491,7 @@
|
||||
;; Calendar month view for browsing/toggling entries (B1)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-cal-entry-associated (&key name toggle-url csrf)
|
||||
(defcomp ~admin/cal-entry-associated (&key name toggle-url csrf)
|
||||
(div :class "flex items-center gap-1 text-[10px] rounded px-1 py-0.5 bg-green-200 text-green-900"
|
||||
(span :class "truncate flex-1" name)
|
||||
(button :type "button" :class "flex-shrink-0 hover:text-red-600"
|
||||
@@ -505,7 +505,7 @@
|
||||
:sx-on:afterSwap "document.body.dispatchEvent(new CustomEvent('entryToggled'))"
|
||||
(i :class "fa fa-times"))))
|
||||
|
||||
(defcomp ~blog-cal-entry-unassociated (&key name toggle-url csrf)
|
||||
(defcomp ~admin/cal-entry-unassociated (&key name toggle-url csrf)
|
||||
(button :type "button"
|
||||
:class "w-full text-left text-[10px] rounded px-1 py-0.5 bg-stone-100 text-stone-700 hover:bg-stone-200"
|
||||
:data-confirm "" :data-confirm-title "Add entry?"
|
||||
@@ -518,7 +518,7 @@
|
||||
:sx-on:afterSwap "document.body.dispatchEvent(new CustomEvent('entryToggled'))"
|
||||
(span :class "truncate block" name)))
|
||||
|
||||
(defcomp ~blog-calendar-view (&key cal-id year month-name
|
||||
(defcomp ~admin/calendar-view (&key cal-id year month-name
|
||||
current-url prev-month-url prev-year-url
|
||||
next-month-url next-year-url
|
||||
weekday-names days csrf)
|
||||
@@ -553,9 +553,9 @@
|
||||
(div :class "space-y-0.5"
|
||||
(map (lambda (e)
|
||||
(if (get e "is_associated")
|
||||
(~blog-cal-entry-associated
|
||||
(~admin/cal-entry-associated
|
||||
:name (get e "name") :toggle-url (get e "toggle_url") :csrf csrf)
|
||||
(~blog-cal-entry-unassociated
|
||||
(~admin/cal-entry-unassociated
|
||||
:name (get e "name") :toggle-url (get e "toggle_url") :csrf csrf)))
|
||||
entries))))))
|
||||
(or days (list))))))))
|
||||
@@ -564,15 +564,15 @@
|
||||
;; Nav entries OOB — renders associated entry/calendar items in scroll wrapper (B2)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-nav-entries-oob (&key entries calendars)
|
||||
(defcomp ~admin/nav-entries-oob (&key entries calendars)
|
||||
(let* ((entry-list (or entries (list)))
|
||||
(cal-list (or calendars (list)))
|
||||
(has-items (or (not (empty? entry-list)) (not (empty? cal-list))))
|
||||
(nav-cls "justify-center cursor-pointer flex flex-row items-center gap-2 rounded bg-stone-200 text-black [.hover-capable_&]:hover:bg-yellow-300 aria-selected:bg-stone-500 aria-selected:text-white [.hover-capable_&[aria-selected=true]:hover]:bg-orange-500 p-2")
|
||||
(scroll-hs "on load or scroll if window.innerWidth >= 640 and my.scrollWidth > my.clientWidth remove .hidden from .entries-nav-arrow add .flex to .entries-nav-arrow else add .hidden to .entries-nav-arrow remove .flex from .entries-nav-arrow end"))
|
||||
(if (not has-items)
|
||||
(~blog-nav-entries-empty)
|
||||
(~scroll-nav-wrapper
|
||||
(~shared:nav/blog-nav-entries-empty)
|
||||
(~shared:misc/scroll-nav-wrapper
|
||||
:wrapper-id "entries-calendars-nav-wrapper"
|
||||
:container-id "associated-items-container"
|
||||
:arrow-cls "entries-nav-arrow"
|
||||
@@ -581,12 +581,12 @@
|
||||
:right-hs "on click set #associated-items-container.scrollLeft to #associated-items-container.scrollLeft + 200"
|
||||
:items (<>
|
||||
(map (lambda (e)
|
||||
(~calendar-entry-nav
|
||||
(~shared:navigation/calendar-entry-nav
|
||||
:href (get e "href") :nav-class nav-cls
|
||||
:name (get e "name") :date-str (get e "date_str")))
|
||||
entry-list)
|
||||
(map (lambda (c)
|
||||
(~blog-nav-calendar-item
|
||||
(~shared:nav/blog-nav-calendar-item
|
||||
:href (get c "href") :nav-cls nav-cls
|
||||
:name (get c "name")))
|
||||
cal-list))
|
||||
|
||||
@@ -1,59 +1,59 @@
|
||||
;; Blog card components — pure data, no HTML injection
|
||||
|
||||
(defcomp ~blog-like-button (&key like-url hx-headers heart)
|
||||
(defcomp ~cards/like-button (&key like-url hx-headers heart)
|
||||
(div :class "absolute top-20 right-2 z-10 text-6xl md:text-4xl"
|
||||
(~blog-like-toggle :like-url like-url :hx-headers hx-headers :heart heart)))
|
||||
(~detail/like-toggle :like-url like-url :hx-headers hx-headers :heart heart)))
|
||||
|
||||
(defcomp ~blog-draft-status (&key publish-requested timestamp)
|
||||
(defcomp ~cards/draft-status (&key (publish-requested :as boolean) (timestamp :as string?))
|
||||
(<> (div :class "flex justify-center gap-2 mt-1"
|
||||
(span :class "inline-block px-2 py-0.5 rounded-full text-xs font-semibold bg-amber-100 text-amber-800" "Draft")
|
||||
(when publish-requested (span :class "inline-block px-2 py-0.5 rounded-full text-xs font-semibold bg-blue-100 text-blue-800" "Publish requested")))
|
||||
(when timestamp (p :class "text-sm text-stone-500" (str "Updated: " timestamp)))))
|
||||
|
||||
(defcomp ~blog-published-status (&key timestamp)
|
||||
(defcomp ~cards/published-status (&key (timestamp :as string))
|
||||
(p :class "text-sm text-stone-500" (str "Published: " timestamp)))
|
||||
|
||||
;; Tag components — accept data, not HTML
|
||||
(defcomp ~blog-tag-icon (&key src name initial)
|
||||
(defcomp ~cards/tag-icon (&key (src :as string?) (name :as string) (initial :as string))
|
||||
(if src
|
||||
(img :src src :alt name :class "h-4 w-4 rounded-full object-cover border border-stone-300 flex-shrink-0")
|
||||
(div :class "h-4 w-4 rounded-full text-[8px] font-semibold flex items-center justify-center border border-stone-300 flex-shrink-0 bg-stone-200 text-stone-600" initial)))
|
||||
|
||||
(defcomp ~blog-tag-item (&key src name initial)
|
||||
(defcomp ~cards/tag-item (&key src name initial)
|
||||
(li (a :class "flex items-center gap-1"
|
||||
(~blog-tag-icon :src src :name name :initial initial)
|
||||
(~cards/tag-icon :src src :name name :initial initial)
|
||||
(span :class "inline-block rounded-full bg-stone-100 text-stone-600 px-2 py-1 text-sm font-medium border border-stone-200" name))))
|
||||
|
||||
;; At-bar — tags + authors row for detail pages
|
||||
(defcomp ~blog-at-bar (&key tags authors)
|
||||
(defcomp ~cards/at-bar (&key tags authors)
|
||||
(when (or tags authors)
|
||||
(div :class "flex flex-row justify-center gap-3"
|
||||
(when tags
|
||||
(div :class "mt-4 flex items-center gap-2" (div "in")
|
||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
||||
(map (lambda (t) (~blog-tag-item :src (get t "src") :name (get t "name") :initial (get t "initial"))) tags))))
|
||||
(map (lambda (t) (~cards/tag-item :src (get t "src") :name (get t "name") :initial (get t "initial"))) tags))))
|
||||
(div)
|
||||
(when authors
|
||||
(div :class "mt-4 flex items-center gap-2" (div "by")
|
||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
||||
(map (lambda (a) (~blog-author-item :image (get a "image") :name (get a "name"))) authors)))))))
|
||||
(map (lambda (a) (~cards/author-item :image (get a "image") :name (get a "name"))) authors)))))))
|
||||
|
||||
;; Author components
|
||||
(defcomp ~blog-author-item (&key image name)
|
||||
(defcomp ~cards/author-item (&key image name)
|
||||
(li :class "flex items-center gap-1"
|
||||
(when image (img :src image :alt name :class "h-5 w-5 rounded-full object-cover"))
|
||||
(span :class "text-stone-700" name)))
|
||||
|
||||
;; Card — accepts pure data
|
||||
(defcomp ~blog-card (&key slug href hx-select title
|
||||
feature-image excerpt
|
||||
status is-draft publish-requested status-timestamp
|
||||
liked like-url csrf-token
|
||||
has-like
|
||||
tags authors widget)
|
||||
(defcomp ~cards/index (&key (slug :as string) (href :as string) (hx-select :as string?) (title :as string)
|
||||
(feature-image :as string?) (excerpt :as string?)
|
||||
status (is-draft :as boolean) (publish-requested :as boolean) (status-timestamp :as string?)
|
||||
(liked :as boolean) (like-url :as string?) (csrf-token :as string?)
|
||||
(has-like :as boolean)
|
||||
(tags :as list?) (authors :as list?) widget)
|
||||
(article :class "border-b pb-6 last:border-b-0 relative"
|
||||
(when has-like
|
||||
(~blog-like-button
|
||||
(~cards/like-button
|
||||
:like-url like-url
|
||||
:hx-headers {:X-CSRFToken csrf-token}
|
||||
:heart (if liked "❤️" "🤍")))
|
||||
@@ -63,8 +63,8 @@
|
||||
(header :class "mb-2 text-center"
|
||||
(h2 :class "text-4xl font-bold text-stone-900" title)
|
||||
(if is-draft
|
||||
(~blog-draft-status :publish-requested publish-requested :timestamp status-timestamp)
|
||||
(when status-timestamp (~blog-published-status :timestamp status-timestamp))))
|
||||
(~cards/draft-status :publish-requested publish-requested :timestamp status-timestamp)
|
||||
(when status-timestamp (~cards/published-status :timestamp status-timestamp))))
|
||||
(when feature-image (div :class "mb-4" (img :src feature-image :alt "" :class "rounded-lg w-full object-cover")))
|
||||
(when excerpt (p :class "text-stone-700 text-lg leading-relaxed text-center" excerpt)))
|
||||
widget
|
||||
@@ -73,16 +73,16 @@
|
||||
(when tags
|
||||
(div :class "mt-4 flex items-center gap-2" (div "in")
|
||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
||||
(map (lambda (t) (~blog-tag-item :src (get t "src") :name (get t "name") :initial (get t "initial"))) tags))))
|
||||
(map (lambda (t) (~cards/tag-item :src (get t "src") :name (get t "name") :initial (get t "initial"))) tags))))
|
||||
(div)
|
||||
(when authors
|
||||
(div :class "mt-4 flex items-center gap-2" (div "by")
|
||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
||||
(map (lambda (a) (~blog-author-item :image (get a "image") :name (get a "name"))) authors))))))))
|
||||
(map (lambda (a) (~cards/author-item :image (get a "image") :name (get a "name"))) authors))))))))
|
||||
|
||||
(defcomp ~blog-card-tile (&key href hx-select feature-image title
|
||||
is-draft publish-requested status-timestamp
|
||||
excerpt tags authors)
|
||||
(defcomp ~cards/tile (&key (href :as string) (hx-select :as string?) (feature-image :as string?) (title :as string)
|
||||
(is-draft :as boolean) (publish-requested :as boolean) (status-timestamp :as string?)
|
||||
(excerpt :as string?) (tags :as list?) (authors :as list?))
|
||||
(article :class "relative"
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select (or hx-select "#main-panel") :sx-swap "outerHTML" :sx-push-url "true"
|
||||
@@ -91,33 +91,33 @@
|
||||
(div :class "p-3 text-center"
|
||||
(h2 :class "text-lg font-bold text-stone-900" title)
|
||||
(if is-draft
|
||||
(~blog-draft-status :publish-requested publish-requested :timestamp status-timestamp)
|
||||
(when status-timestamp (~blog-published-status :timestamp status-timestamp)))
|
||||
(~cards/draft-status :publish-requested publish-requested :timestamp status-timestamp)
|
||||
(when status-timestamp (~cards/published-status :timestamp status-timestamp)))
|
||||
(when excerpt (p :class "text-stone-700 text-sm leading-relaxed line-clamp-3 mt-1" excerpt))))
|
||||
(when (or tags authors)
|
||||
(div :class "flex flex-row justify-center gap-3"
|
||||
(when tags
|
||||
(div :class "mt-4 flex items-center gap-2" (div "in")
|
||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
||||
(map (lambda (t) (~blog-tag-item :src (get t "src") :name (get t "name") :initial (get t "initial"))) tags))))
|
||||
(map (lambda (t) (~cards/tag-item :src (get t "src") :name (get t "name") :initial (get t "initial"))) tags))))
|
||||
(div)
|
||||
(when authors
|
||||
(div :class "mt-4 flex items-center gap-2" (div "by")
|
||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
||||
(map (lambda (a) (~blog-author-item :image (get a "image") :name (get a "name"))) authors))))))))
|
||||
(map (lambda (a) (~cards/author-item :image (get a "image") :name (get a "name"))) authors))))))))
|
||||
|
||||
;; Data-driven blog cards list (replaces Python _blog_cards_sx loop)
|
||||
(defcomp ~blog-cards-from-data (&key posts view sentinel)
|
||||
(defcomp ~cards/from-data (&key (posts :as list?) (view :as string?) sentinel)
|
||||
(<>
|
||||
(map (lambda (p)
|
||||
(if (= view "tile")
|
||||
(~blog-card-tile
|
||||
(~cards/tile
|
||||
:href (get p "href") :hx-select (get p "hx_select")
|
||||
:feature-image (get p "feature_image") :title (get p "title")
|
||||
:is-draft (get p "is_draft") :publish-requested (get p "publish_requested")
|
||||
:status-timestamp (get p "status_timestamp")
|
||||
:excerpt (get p "excerpt") :tags (get p "tags") :authors (get p "authors"))
|
||||
(~blog-card
|
||||
(~cards/index
|
||||
:slug (get p "slug") :href (get p "href") :hx-select (get p "hx_select")
|
||||
:title (get p "title") :feature-image (get p "feature_image")
|
||||
:excerpt (get p "excerpt") :is-draft (get p "is_draft")
|
||||
@@ -131,10 +131,10 @@
|
||||
sentinel))
|
||||
|
||||
;; Data-driven page cards list (replaces Python _page_cards_sx loop)
|
||||
(defcomp ~page-cards-from-data (&key pages sentinel)
|
||||
(defcomp ~cards/page-cards-from-data (&key (pages :as list?) sentinel)
|
||||
(<>
|
||||
(map (lambda (pg)
|
||||
(~blog-page-card
|
||||
(~cards/page-card
|
||||
:href (get pg "href") :hx-select (get pg "hx_select")
|
||||
:title (get pg "title")
|
||||
:has-calendar (get pg "has_calendar") :has-market (get pg "has_market")
|
||||
@@ -143,21 +143,21 @@
|
||||
(or pages (list)))
|
||||
sentinel))
|
||||
|
||||
(defcomp ~blog-page-badges (&key has-calendar has-market)
|
||||
(defcomp ~cards/page-badges (&key has-calendar has-market)
|
||||
(div :class "flex justify-center gap-2 mt-2"
|
||||
(when has-calendar (span :class "inline-block px-2 py-0.5 rounded-full text-xs font-semibold bg-blue-100 text-blue-800"
|
||||
(i :class "fa fa-calendar mr-1") "Calendar"))
|
||||
(when has-market (span :class "inline-block px-2 py-0.5 rounded-full text-xs font-semibold bg-green-100 text-green-800"
|
||||
(i :class "fa fa-shopping-bag mr-1") "Market"))))
|
||||
|
||||
(defcomp ~blog-page-card (&key href hx-select title has-calendar has-market pub-timestamp feature-image excerpt)
|
||||
(defcomp ~cards/page-card (&key (href :as string) (hx-select :as string?) (title :as string) (has-calendar :as boolean) (has-market :as boolean) (pub-timestamp :as string?) (feature-image :as string?) (excerpt :as string?))
|
||||
(article :class "border-b pb-6 last:border-b-0 relative"
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select (or hx-select "#main-panel") :sx-swap "outerHTML" :sx-push-url "true"
|
||||
:class "block rounded-xl bg-white shadow hover:shadow-md transition overflow-hidden"
|
||||
(header :class "mb-2 text-center"
|
||||
(h2 :class "text-4xl font-bold text-stone-900" title)
|
||||
(~blog-page-badges :has-calendar has-calendar :has-market has-market)
|
||||
(when pub-timestamp (~blog-published-status :timestamp pub-timestamp)))
|
||||
(~cards/page-badges :has-calendar has-calendar :has-market has-market)
|
||||
(when pub-timestamp (~cards/published-status :timestamp pub-timestamp)))
|
||||
(when feature-image (div :class "mb-4" (img :src feature-image :alt "" :class "rounded-lg w-full object-cover")))
|
||||
(when excerpt (p :class "text-stone-700 text-lg leading-relaxed text-center" excerpt)))))
|
||||
|
||||
@@ -1,34 +1,34 @@
|
||||
;; Blog post detail components
|
||||
|
||||
(defcomp ~blog-detail-edit-link (&key href hx-select)
|
||||
(defcomp ~detail/edit-link (&key (href :as string) (hx-select :as string))
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
:class "inline-block px-3 py-1 rounded-full text-sm font-semibold bg-stone-700 text-white hover:bg-stone-800 transition-colors"
|
||||
(i :class "fa fa-pencil mr-1") " Edit"))
|
||||
|
||||
(defcomp ~blog-detail-draft (&key publish-requested edit)
|
||||
(defcomp ~detail/draft (&key publish-requested edit)
|
||||
(div :class "flex items-center justify-center gap-2 mb-3"
|
||||
(span :class "inline-block px-3 py-1 rounded-full text-sm font-semibold bg-amber-100 text-amber-800" "Draft")
|
||||
(when publish-requested (span :class "inline-block px-3 py-1 rounded-full text-sm font-semibold bg-blue-100 text-blue-800" "Publish requested"))
|
||||
edit))
|
||||
|
||||
(defcomp ~blog-like-toggle (&key like-url hx-headers heart)
|
||||
(defcomp ~detail/like-toggle (&key like-url hx-headers heart)
|
||||
(button :sx-post like-url :sx-swap "outerHTML"
|
||||
:sx-headers hx-headers :class "cursor-pointer" heart))
|
||||
|
||||
(defcomp ~blog-detail-like (&key like-url hx-headers heart)
|
||||
(defcomp ~detail/like (&key like-url hx-headers heart)
|
||||
(div :class "absolute top-2 right-2 z-10 text-8xl md:text-6xl"
|
||||
(~blog-like-toggle :like-url like-url :hx-headers hx-headers :heart heart)))
|
||||
(~detail/like-toggle :like-url like-url :hx-headers hx-headers :heart heart)))
|
||||
|
||||
(defcomp ~blog-detail-excerpt (&key excerpt)
|
||||
(defcomp ~detail/excerpt (&key (excerpt :as string))
|
||||
(div :class "w-full text-center italic text-3xl p-2" excerpt))
|
||||
|
||||
(defcomp ~blog-detail-chrome (&key like excerpt at-bar)
|
||||
(defcomp ~detail/chrome (&key like excerpt at-bar)
|
||||
(<> like
|
||||
excerpt
|
||||
(div :class "hidden md:block" at-bar)))
|
||||
|
||||
(defcomp ~blog-detail-main (&key draft chrome feature-image html-content sx-content)
|
||||
(defcomp ~detail/main (&key draft chrome feature-image html-content sx-content)
|
||||
(<> (article :class "relative"
|
||||
draft
|
||||
chrome
|
||||
@@ -43,34 +43,34 @@
|
||||
;; Data-driven composition — replaces _post_main_panel_sx
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-post-detail-content (&key slug is-draft publish-requested can-edit edit-href
|
||||
is-page has-user liked like-url csrf
|
||||
custom-excerpt tags authors
|
||||
feature-image html-content sx-content)
|
||||
(defcomp ~detail/post-detail-content (&key (slug :as string) (is-draft :as boolean) (publish-requested :as boolean) (can-edit :as boolean) (edit-href :as string?)
|
||||
(is-page :as boolean) (has-user :as boolean) (liked :as boolean) (like-url :as string?) (csrf :as string?)
|
||||
(custom-excerpt :as string?) (tags :as list?) (authors :as list?)
|
||||
(feature-image :as string?) (html-content :as string?) (sx-content :as string?))
|
||||
(let* ((hx-select "#main-panel")
|
||||
(draft-sx (when is-draft
|
||||
(~blog-detail-draft
|
||||
(~detail/draft
|
||||
:publish-requested publish-requested
|
||||
:edit (when can-edit
|
||||
(~blog-detail-edit-link :href edit-href :hx-select hx-select)))))
|
||||
(~detail/edit-link :href edit-href :hx-select hx-select)))))
|
||||
(chrome-sx (when (not is-page)
|
||||
(~blog-detail-chrome
|
||||
(~detail/chrome
|
||||
:like (when has-user
|
||||
(~blog-detail-like
|
||||
(~detail/like
|
||||
:like-url like-url
|
||||
:hx-headers {:X-CSRFToken csrf}
|
||||
:heart (if liked "❤️" "🤍")))
|
||||
:excerpt (when (not (= custom-excerpt ""))
|
||||
(~blog-detail-excerpt :excerpt custom-excerpt))
|
||||
:at-bar (~blog-at-bar :tags tags :authors authors)))))
|
||||
(~blog-detail-main
|
||||
(~detail/excerpt :excerpt custom-excerpt))
|
||||
:at-bar (~cards/at-bar :tags tags :authors authors)))))
|
||||
(~detail/main
|
||||
:draft draft-sx
|
||||
:chrome chrome-sx
|
||||
:feature-image feature-image
|
||||
:html-content html-content
|
||||
:sx-content sx-content)))
|
||||
|
||||
(defcomp ~blog-meta (&key robots page-title desc canonical og-type og-title image twitter-card twitter-title)
|
||||
(defcomp ~detail/meta (&key (robots :as string) (page-title :as string) (desc :as string) (canonical :as string?) (og-type :as string) (og-title :as string) (image :as string?) (twitter-card :as string) (twitter-title :as string))
|
||||
(<>
|
||||
(meta :name "robots" :content robots)
|
||||
(title page-title)
|
||||
@@ -86,7 +86,7 @@
|
||||
(meta :name "twitter:description" :content desc)
|
||||
(when image (meta :name "twitter:image" :content image))))
|
||||
|
||||
(defcomp ~blog-home-main (&key html-content sx-content)
|
||||
(defcomp ~detail/home-main (&key html-content sx-content)
|
||||
(article :class "relative"
|
||||
(if sx-content
|
||||
(div :class "blog-content p-2" sx-content)
|
||||
|
||||
@@ -1,10 +1,10 @@
|
||||
;; Blog editor components
|
||||
|
||||
(defcomp ~blog-editor-error (&key error)
|
||||
(defcomp ~editor/error (&key error)
|
||||
(div :class "max-w-[768px] mx-auto mt-[16px] rounded-[8px] border border-red-300 bg-red-50 px-[16px] py-[12px] text-[14px] text-red-700"
|
||||
(strong "Save failed:") " " error))
|
||||
|
||||
(defcomp ~blog-editor-form (&key csrf title-placeholder create-label)
|
||||
(defcomp ~editor/form (&key (csrf :as string) (title-placeholder :as string) (create-label :as string))
|
||||
(form :id "post-new-form" :method "post" :class "max-w-[768px] mx-auto pb-[48px]"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(input :type "hidden" :id "lexical-json-input" :name "lexical" :value "")
|
||||
@@ -56,11 +56,11 @@
|
||||
:class "px-[20px] py-[6px] bg-stone-700 text-white text-[14px] rounded-[8px] hover:bg-stone-800 transition-colors cursor-pointer" create-label))))
|
||||
|
||||
;; Edit form — pre-populated version for /<slug>/admin/edit/
|
||||
(defcomp ~blog-editor-edit-form (&key csrf updated-at title-val excerpt-val
|
||||
feature-image feature-image-caption
|
||||
sx-content-val lexical-json
|
||||
has-sx title-placeholder
|
||||
status already-emailed
|
||||
(defcomp ~editor/edit-form (&key (csrf :as string) (updated-at :as string) (title-val :as string?) (excerpt-val :as string?)
|
||||
(feature-image :as string?) (feature-image-caption :as string?)
|
||||
(sx-content-val :as string?) (lexical-json :as string?)
|
||||
(has-sx :as boolean) (title-placeholder :as string)
|
||||
(status :as string) (already-emailed :as boolean)
|
||||
newsletter-options footer-extra)
|
||||
(let* ((sel-cls "text-[14px] rounded-[4px] border border-stone-200 px-[8px] py-[6px] bg-white text-stone-600")
|
||||
(active "px-[12px] py-[6px] text-[13px] font-medium text-stone-700 border-b-2 border-stone-700 cursor-pointer bg-transparent")
|
||||
@@ -135,7 +135,7 @@
|
||||
(when footer-extra footer-extra)))))
|
||||
|
||||
;; Publish-mode show/hide script for edit form
|
||||
(defcomp ~blog-editor-publish-js (&key already-emailed)
|
||||
(defcomp ~editor/publish-js (&key already-emailed)
|
||||
(script
|
||||
"(function() {"
|
||||
" var statusSel = document.getElementById('status-select');"
|
||||
@@ -153,20 +153,20 @@
|
||||
" sync();"
|
||||
"})();"))
|
||||
|
||||
(defcomp ~blog-editor-styles (&key css-href)
|
||||
(defcomp ~editor/styles (&key (css-href :as string))
|
||||
(<> (link :rel "stylesheet" :href css-href)
|
||||
(style
|
||||
"#lexical-editor { display: flow-root; }"
|
||||
"#lexical-editor [data-kg-card=\"html\"] * { float: none !important; }"
|
||||
"#lexical-editor [data-kg-card=\"html\"] table { width: 100% !important; }")))
|
||||
|
||||
(defcomp ~blog-editor-scripts (&key js-src sx-editor-js-src init-js)
|
||||
(defcomp ~editor/scripts (&key (js-src :as string) (sx-editor-js-src :as string?) (init-js :as string))
|
||||
(<> (script :src js-src)
|
||||
(when sx-editor-js-src (script :src sx-editor-js-src))
|
||||
(script init-js)))
|
||||
|
||||
;; SX editor styles — comprehensive CSS for the Koenig-style block editor
|
||||
(defcomp ~sx-editor-styles ()
|
||||
(defcomp ~editor/sx-editor-styles ()
|
||||
(style
|
||||
;; Editor container
|
||||
".sx-editor { position: relative; font-size: 18px; line-height: 1.6; font-family: Georgia, 'Times New Roman', serif; color: #1c1917; }"
|
||||
@@ -308,34 +308,34 @@
|
||||
;; Editor panel composition — replaces render_editor_panel (new post/page)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-editor-content (&key csrf title-placeholder create-label
|
||||
(defcomp ~editor/content (&key csrf title-placeholder create-label
|
||||
css-href js-src sx-editor-js-src init-js
|
||||
save-error)
|
||||
(~blog-editor-panel :parts
|
||||
(~layouts/editor-panel :parts
|
||||
(<>
|
||||
(when save-error (~blog-editor-error :error save-error))
|
||||
(~blog-editor-form :csrf csrf :title-placeholder title-placeholder
|
||||
(when save-error (~editor/error :error save-error))
|
||||
(~editor/form :csrf csrf :title-placeholder title-placeholder
|
||||
:create-label create-label)
|
||||
(~blog-editor-styles :css-href css-href)
|
||||
(~sx-editor-styles)
|
||||
(~blog-editor-scripts :js-src js-src :sx-editor-js-src sx-editor-js-src
|
||||
(~editor/styles :css-href css-href)
|
||||
(~editor/sx-editor-styles)
|
||||
(~editor/scripts :js-src js-src :sx-editor-js-src sx-editor-js-src
|
||||
:init-js init-js))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Edit content composition — replaces _h_post_edit_content (existing post)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-edit-content (&key csrf updated-at title-val excerpt-val
|
||||
(defcomp ~editor/edit-content (&key csrf updated-at title-val excerpt-val
|
||||
feature-image feature-image-caption
|
||||
sx-content-val lexical-json has-sx
|
||||
title-placeholder status already-emailed
|
||||
newsletter-options footer-extra
|
||||
css-href js-src sx-editor-js-src init-js
|
||||
save-error)
|
||||
(~blog-editor-panel :parts
|
||||
(~layouts/editor-panel :parts
|
||||
(<>
|
||||
(when save-error (~blog-editor-error :error save-error))
|
||||
(~blog-editor-edit-form
|
||||
(when save-error (~editor/error :error save-error))
|
||||
(~editor/edit-form
|
||||
:csrf csrf :updated-at updated-at
|
||||
:title-val title-val :excerpt-val excerpt-val
|
||||
:feature-image feature-image :feature-image-caption feature-image-caption
|
||||
@@ -343,8 +343,8 @@
|
||||
:has-sx has-sx :title-placeholder title-placeholder
|
||||
:status status :already-emailed already-emailed
|
||||
:newsletter-options newsletter-options :footer-extra footer-extra)
|
||||
(~blog-editor-publish-js :already-emailed already-emailed)
|
||||
(~blog-editor-styles :css-href css-href)
|
||||
(~sx-editor-styles)
|
||||
(~blog-editor-scripts :js-src js-src :sx-editor-js-src sx-editor-js-src
|
||||
(~editor/publish-js :already-emailed already-emailed)
|
||||
(~editor/styles :css-href css-href)
|
||||
(~editor/sx-editor-styles)
|
||||
(~editor/scripts :js-src js-src :sx-editor-js-src sx-editor-js-src
|
||||
:init-js init-js))))
|
||||
|
||||
@@ -1,37 +1,37 @@
|
||||
;; Blog filter components
|
||||
|
||||
(defcomp ~blog-action-button (&key href hx-select btn-class title icon-class label)
|
||||
(defcomp ~filters/action-button (&key (href :as string) (hx-select :as string) (btn-class :as string) (title :as string) (icon-class :as string) (label :as string))
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
:class btn-class :title title (i :class icon-class) label))
|
||||
|
||||
(defcomp ~blog-drafts-button (&key href hx-select btn-class title label draft-count)
|
||||
(defcomp ~filters/drafts-button (&key (href :as string) (hx-select :as string) (btn-class :as string) (title :as string) (label :as string) (draft-count :as number))
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
:class btn-class :title title (i :class "fa fa-file-text-o mr-1") " Drafts "
|
||||
(span :class "inline-block bg-stone-500 text-white px-1.5 py-0.5 text-xs font-medium rounded ml-1" draft-count)))
|
||||
|
||||
(defcomp ~blog-drafts-button-amber (&key href hx-select btn-class title label draft-count)
|
||||
(defcomp ~filters/drafts-button-amber (&key href hx-select btn-class title label draft-count)
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
:class btn-class :title title (i :class "fa fa-file-text-o mr-1") " Drafts "
|
||||
(span :class "inline-block bg-amber-500 text-white px-1.5 py-0.5 text-xs font-medium rounded ml-1" draft-count)))
|
||||
|
||||
(defcomp ~blog-action-buttons-wrapper (&key inner)
|
||||
(defcomp ~filters/action-buttons-wrapper (&key inner)
|
||||
(div :class "flex flex-wrap gap-2 px-4 py-3" inner))
|
||||
|
||||
(defcomp ~blog-filter-any-topic (&key cls hx-select)
|
||||
(defcomp ~filters/any-topic (&key cls hx-select)
|
||||
(li (a :class (str "px-3 py-1 rounded border " cls)
|
||||
:sx-get "?page=1" :sx-target "#main-panel" :sx-select hx-select
|
||||
:sx-swap "outerHTML" :sx-push-url "true" "Any Topic")))
|
||||
|
||||
(defcomp ~blog-filter-group-icon-image (&key src name)
|
||||
(defcomp ~filters/group-icon-image (&key src name)
|
||||
(img :src src :alt name :class "h-6 w-6 rounded-full object-cover border border-stone-300 flex-shrink-0"))
|
||||
|
||||
(defcomp ~blog-filter-group-icon-color (&key style initial)
|
||||
(defcomp ~filters/group-icon-color (&key style initial)
|
||||
(div :class "h-6 w-6 rounded-full text-[10px] font-semibold flex items-center justify-center border border-stone-300 flex-shrink-0" :style style initial))
|
||||
|
||||
(defcomp ~blog-filter-group-li (&key cls hx-get hx-select icon name count)
|
||||
(defcomp ~filters/group-li (&key cls hx-get hx-select icon name count)
|
||||
(li (a :class (str "flex items-center gap-2 px-3 py-1 rounded border " cls)
|
||||
:sx-get hx-get :sx-target "#main-panel" :sx-select hx-select
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
@@ -40,19 +40,19 @@
|
||||
(span :class "flex-1")
|
||||
(span :class "inline-block bg-stone-100 text-stone-600 px-2 py-1 text-xs font-medium border border-stone-200" count))))
|
||||
|
||||
(defcomp ~blog-filter-nav (&key items)
|
||||
(defcomp ~filters/nav (&key items)
|
||||
(nav :class "max-w-3xl mx-auto px-4 pb-4 flex flex-wrap gap-2 text-sm"
|
||||
(ul :class "divide-y flex flex-col gap-3" items)))
|
||||
|
||||
(defcomp ~blog-filter-any-author (&key cls hx-select)
|
||||
(defcomp ~filters/any-author (&key cls hx-select)
|
||||
(li (a :class (str "px-3 py-1 rounded " cls)
|
||||
:sx-get "?page=1" :sx-target "#main-panel" :sx-select hx-select
|
||||
:sx-swap "outerHTML" :sx-push-url "true" "Any author")))
|
||||
|
||||
(defcomp ~blog-filter-author-icon (&key src name)
|
||||
(defcomp ~filters/author-icon (&key src name)
|
||||
(img :src src :alt name :class "h-5 w-5 rounded-full object-cover"))
|
||||
|
||||
(defcomp ~blog-filter-author-li (&key cls hx-get hx-select icon name count)
|
||||
(defcomp ~filters/author-li (&key cls hx-get hx-select icon name count)
|
||||
(li (a :class (str "flex items-center gap-2 px-3 py-1 rounded " cls)
|
||||
:sx-get hx-get :sx-target "#main-panel" :sx-select hx-select
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
@@ -61,41 +61,41 @@
|
||||
(span :class "flex-1")
|
||||
(span :class "inline-block bg-stone-100 text-stone-600 px-2 py-1 text-xs font-medium border border-stone-200" count))))
|
||||
|
||||
(defcomp ~blog-filter-summary (&key text)
|
||||
(defcomp ~filters/summary (&key (text :as string))
|
||||
(span :class "text-sm text-stone-600" text))
|
||||
|
||||
;; Data-driven tag groups filter (replaces Python _tag_groups_filter_sx loop)
|
||||
(defcomp ~blog-tag-groups-filter-from-data (&key groups selected-groups hx-select)
|
||||
(defcomp ~filters/tag-groups-filter-from-data (&key groups selected-groups hx-select)
|
||||
(let* ((is-any (empty? (or selected-groups (list))))
|
||||
(any-cls (if is-any "bg-stone-900 text-white border-stone-900" "bg-white text-stone-600 border-stone-300 hover:bg-stone-50")))
|
||||
(~blog-filter-nav
|
||||
(~filters/nav
|
||||
:items (<>
|
||||
(~blog-filter-any-topic :cls any-cls :hx-select hx-select)
|
||||
(~filters/any-topic :cls any-cls :hx-select hx-select)
|
||||
(map (lambda (g)
|
||||
(let* ((slug (get g "slug"))
|
||||
(name (get g "name"))
|
||||
(is-on (contains? selected-groups slug))
|
||||
(cls (if is-on "bg-stone-900 text-white border-stone-900" "bg-white text-stone-600 border-stone-300 hover:bg-stone-50"))
|
||||
(icon (if (get g "feature_image")
|
||||
(~blog-filter-group-icon-image :src (get g "feature_image") :name name)
|
||||
(~blog-filter-group-icon-color :style (get g "style") :initial (get g "initial")))))
|
||||
(~blog-filter-group-li :cls cls :hx-get (str "?group=" slug "&page=1") :hx-select hx-select
|
||||
(~filters/group-icon-image :src (get g "feature_image") :name name)
|
||||
(~filters/group-icon-color :style (get g "style") :initial (get g "initial")))))
|
||||
(~filters/group-li :cls cls :hx-get (str "?group=" slug "&page=1") :hx-select hx-select
|
||||
:icon icon :name name :count (get g "count"))))
|
||||
(or groups (list)))))))
|
||||
|
||||
;; Data-driven authors filter (replaces Python _authors_filter_sx loop)
|
||||
(defcomp ~blog-authors-filter-from-data (&key authors selected-authors hx-select)
|
||||
(defcomp ~filters/authors-filter-from-data (&key authors selected-authors hx-select)
|
||||
(let* ((is-any (empty? (or selected-authors (list))))
|
||||
(any-cls (if is-any "bg-stone-900 text-white border-stone-900" "bg-white text-stone-600 border-stone-300 hover:bg-stone-50")))
|
||||
(~blog-filter-nav
|
||||
(~filters/nav
|
||||
:items (<>
|
||||
(~blog-filter-any-author :cls any-cls :hx-select hx-select)
|
||||
(~filters/any-author :cls any-cls :hx-select hx-select)
|
||||
(map (lambda (a)
|
||||
(let* ((slug (get a "slug"))
|
||||
(is-on (contains? selected-authors slug))
|
||||
(cls (if is-on "bg-stone-900 text-white border-stone-900" "bg-white text-stone-600 border-stone-300 hover:bg-stone-50"))
|
||||
(icon (when (get a "profile_image")
|
||||
(~blog-filter-author-icon :src (get a "profile_image") :name (get a "name")))))
|
||||
(~blog-filter-author-li :cls cls :hx-get (str "?author=" slug "&page=1") :hx-select hx-select
|
||||
(~filters/author-icon :src (get a "profile_image") :name (get a "name")))))
|
||||
(~filters/author-li :cls cls :hx-get (str "?author=" slug "&page=1") :hx-select hx-select
|
||||
:icon icon :name (get a "name") :count (get a "count"))))
|
||||
(or authors (list)))))))
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
(let ((post (query "blog" "post-by-slug" :slug (trim s))))
|
||||
(when post
|
||||
(<> (str "<!-- fragment:" (trim s) " -->")
|
||||
(~link-card
|
||||
(~shared:fragments/link-card
|
||||
:link (app-url "blog" (str "/" (get post "slug") "/"))
|
||||
:title (get post "title")
|
||||
:image (get post "feature_image")
|
||||
@@ -22,7 +22,7 @@
|
||||
(when slug
|
||||
(let ((post (query "blog" "post-by-slug" :slug slug)))
|
||||
(when post
|
||||
(~link-card
|
||||
(~shared:fragments/link-card
|
||||
:link (app-url "blog" (str "/" (get post "slug") "/"))
|
||||
:title (get post "title")
|
||||
:image (get post "feature_image")
|
||||
|
||||
@@ -30,25 +30,25 @@
|
||||
(app-url "blog" (str "/" item-slug "/"))))
|
||||
(selected (or (= item-slug (or first-seg ""))
|
||||
(= item-slug app))))
|
||||
(~blog-nav-item-link
|
||||
(~shared:nav/blog-nav-item-link
|
||||
:href href
|
||||
:hx-get href
|
||||
:selected (if selected "true" "false")
|
||||
:nav-cls nav-cls
|
||||
:img (~img-or-placeholder
|
||||
:img (~shared:misc/img-or-placeholder
|
||||
:src (get item "feature_image")
|
||||
:alt (or (get item "label") item-slug)
|
||||
:size-cls "w-8 h-8 rounded-full object-cover flex-shrink-0")
|
||||
:label (or (get item "label") item-slug)))) items)
|
||||
|
||||
;; Hardcoded artdag link
|
||||
(~blog-nav-item-link
|
||||
(~shared:nav/blog-nav-item-link
|
||||
:href (app-url "artdag" "/")
|
||||
:hx-get (app-url "artdag" "/")
|
||||
:selected (if (or (= "artdag" (or first-seg ""))
|
||||
(= "artdag" app)) "true" "false")
|
||||
:nav-cls nav-cls
|
||||
:img (~img-or-placeholder
|
||||
:img (~shared:misc/img-or-placeholder
|
||||
:src nil :alt "art-dag"
|
||||
:size-cls "w-8 h-8 rounded-full object-cover flex-shrink-0")
|
||||
:label "art-dag")))
|
||||
@@ -69,8 +69,8 @@
|
||||
(right-hs (str "on click set #" cid ".scrollLeft to #" cid ".scrollLeft + 200")))
|
||||
|
||||
(if (empty? items)
|
||||
(~blog-nav-empty :wrapper-id "menu-items-nav-wrapper")
|
||||
(~scroll-nav-wrapper
|
||||
(~shared:nav/blog-nav-empty :wrapper-id "menu-items-nav-wrapper")
|
||||
(~shared:misc/scroll-nav-wrapper
|
||||
:wrapper-id "menu-items-nav-wrapper"
|
||||
:container-id cid
|
||||
:arrow-cls arrow-cls
|
||||
|
||||
@@ -1,21 +1,21 @@
|
||||
;; Blog header components
|
||||
|
||||
(defcomp ~blog-container-nav (&key container-nav)
|
||||
(defcomp ~header/container-nav (&key container-nav)
|
||||
(div :class "flex flex-col sm:flex-row sm:items-center gap-2 border-r border-stone-200 mr-2 sm:max-w-2xl"
|
||||
:id "entries-calendars-nav-wrapper" container-nav))
|
||||
|
||||
(defcomp ~blog-admin-label ()
|
||||
(defcomp ~header/admin-label ()
|
||||
(<> (i :class "fa fa-shield-halved" :aria-hidden "true") " admin"))
|
||||
|
||||
(defcomp ~blog-admin-nav-item (&key href nav-btn-class label is-selected select-colours)
|
||||
(defcomp ~header/admin-nav-item (&key href nav-btn-class label is-selected select-colours)
|
||||
(div :class "relative nav-group"
|
||||
(a :href href
|
||||
:aria-selected (when is-selected "true")
|
||||
:class (str (or nav-btn-class "justify-center cursor-pointer flex flex-row items-center gap-2 rounded bg-stone-200 text-black p-3") " " (or select-colours ""))
|
||||
label)))
|
||||
|
||||
(defcomp ~blog-sub-settings-label (&key icon label)
|
||||
(defcomp ~header/sub-settings-label (&key icon label)
|
||||
(<> (i :class icon :aria-hidden "true") " " label))
|
||||
|
||||
(defcomp ~blog-sub-admin-label (&key icon label)
|
||||
(defcomp ~header/sub-admin-label (&key icon label)
|
||||
(<> (i :class icon :aria-hidden "true") (div label)))
|
||||
|
||||
106
blog/sx/index.sx
106
blog/sx/index.sx
@@ -1,9 +1,9 @@
|
||||
;; Blog index components
|
||||
|
||||
(defcomp ~blog-no-pages ()
|
||||
(defcomp ~index/no-pages ()
|
||||
(div :class "col-span-full mt-8 text-center text-stone-500" "No pages found."))
|
||||
|
||||
(defcomp ~blog-content-type-tabs (&key posts-href pages-href hx-select posts-cls pages-cls)
|
||||
(defcomp ~index/content-type-tabs (&key posts-href pages-href hx-select posts-cls pages-cls)
|
||||
(div :class "flex justify-center gap-1 px-3 pt-3"
|
||||
(a :href posts-href :sx-get posts-href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
@@ -12,18 +12,18 @@
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
:class (str "px-4 py-1.5 rounded-t text-sm font-medium transition-colors " pages-cls) "Pages")))
|
||||
|
||||
(defcomp ~blog-main-panel-pages (&key tabs cards)
|
||||
(defcomp ~index/main-panel-pages (&key tabs cards)
|
||||
(<> tabs
|
||||
(div :class "max-w-full px-3 py-3 space-y-3" cards)
|
||||
(div :class "pb-8")))
|
||||
|
||||
(defcomp ~blog-main-panel-posts (&key tabs toggle grid-cls cards)
|
||||
(defcomp ~index/main-panel-posts (&key tabs toggle grid-cls cards)
|
||||
(<> tabs
|
||||
toggle
|
||||
(div :class grid-cls cards)
|
||||
(div :class "pb-8")))
|
||||
|
||||
(defcomp ~blog-aside (&key search action-buttons tag-groups-filter authors-filter)
|
||||
(defcomp ~index/aside (&key search action-buttons tag-groups-filter authors-filter)
|
||||
(<> search
|
||||
action-buttons
|
||||
(div :id "category-summary-desktop" :hxx-swap-oob "outerHTML"
|
||||
@@ -36,12 +36,12 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Helper: CSS class for filter item based on selection state
|
||||
(defcomp ~blog-filter-cls (&key is-on)
|
||||
(defcomp ~index/filter-cls (&key is-on)
|
||||
;; Returns nothing — use inline (if is-on ...) instead
|
||||
nil)
|
||||
|
||||
;; Blog index main content — replaces _blog_main_panel_sx
|
||||
(defcomp ~blog-index-main-content (&key content-type view cards page total-pages
|
||||
(defcomp ~index/main-content (&key content-type view cards page total-pages
|
||||
current-local-href hx-select blog-url-base)
|
||||
(let* ((posts-href (str blog-url-base "/index"))
|
||||
(pages-href (str posts-href "?type=pages"))
|
||||
@@ -51,13 +51,13 @@
|
||||
"bg-stone-700 text-white" "bg-stone-100 text-stone-600 hover:bg-stone-200")))
|
||||
(if (= content-type "pages")
|
||||
;; Pages listing
|
||||
(~blog-main-panel-pages
|
||||
:tabs (~blog-content-type-tabs
|
||||
(~index/main-panel-pages
|
||||
:tabs (~index/content-type-tabs
|
||||
:posts-href posts-href :pages-href pages-href
|
||||
:hx-select hx-select :posts-cls posts-cls :pages-cls pages-cls)
|
||||
:cards (<>
|
||||
(map (lambda (card)
|
||||
(~blog-page-card
|
||||
(~cards/page-card
|
||||
:href (get card "href") :hx-select hx-select
|
||||
:title (get card "title")
|
||||
:has-calendar (get card "has_calendar")
|
||||
@@ -67,14 +67,14 @@
|
||||
:excerpt (get card "excerpt")))
|
||||
(or cards (list)))
|
||||
(if (< page total-pages)
|
||||
(~sentinel-simple
|
||||
(~shared:misc/sentinel-simple
|
||||
:id (str "sentinel-" page "-d")
|
||||
:next-url (str current-local-href
|
||||
(if (contains? current-local-href "?") "&" "?")
|
||||
"page=" (+ page 1)))
|
||||
(if (not (empty? (or cards (list))))
|
||||
(~end-of-results)
|
||||
(~blog-no-pages)))))
|
||||
(~shared:misc/end-of-results)
|
||||
(~index/no-pages)))))
|
||||
;; Posts listing
|
||||
(let* ((grid-cls (if (= view "tile")
|
||||
"max-w-full px-3 py-3 grid grid-cols-1 sm:grid-cols-2 md:grid-cols-3 gap-4"
|
||||
@@ -88,19 +88,19 @@
|
||||
(tile-cls (if (= view "tile")
|
||||
"bg-stone-200 text-stone-800"
|
||||
"text-stone-400 hover:text-stone-600")))
|
||||
(~blog-main-panel-posts
|
||||
:tabs (~blog-content-type-tabs
|
||||
(~index/main-panel-posts
|
||||
:tabs (~index/content-type-tabs
|
||||
:posts-href posts-href :pages-href pages-href
|
||||
:hx-select hx-select :posts-cls posts-cls :pages-cls pages-cls)
|
||||
:toggle (~view-toggle
|
||||
:toggle (~shared:misc/view-toggle
|
||||
:list-href list-href :tile-href tile-href :hx-select hx-select
|
||||
:list-cls list-cls :tile-cls tile-cls :storage-key "blog_view"
|
||||
:list-svg (~list-svg) :tile-svg (~tile-svg))
|
||||
:list-svg (~shared:misc/list-svg) :tile-svg (~shared:misc/tile-svg))
|
||||
:grid-cls grid-cls
|
||||
:cards (<>
|
||||
(map (lambda (card)
|
||||
(if (= view "tile")
|
||||
(~blog-card-tile
|
||||
(~cards/tile
|
||||
:href (get card "href") :hx-select hx-select
|
||||
:feature-image (get card "feature_image")
|
||||
:title (get card "title") :is-draft (get card "is_draft")
|
||||
@@ -108,7 +108,7 @@
|
||||
:status-timestamp (get card "status_timestamp")
|
||||
:excerpt (get card "excerpt")
|
||||
:tags (get card "tags") :authors (get card "authors"))
|
||||
(~blog-card
|
||||
(~cards/index
|
||||
:slug (get card "slug") :href (get card "href") :hx-select hx-select
|
||||
:title (get card "title") :feature-image (get card "feature_image")
|
||||
:excerpt (get card "excerpt") :is-draft (get card "is_draft")
|
||||
@@ -119,52 +119,52 @@
|
||||
:tags (get card "tags") :authors (get card "authors")
|
||||
:widget (get card "widget"))))
|
||||
(or cards (list)))
|
||||
(~blog-index-sentinel
|
||||
(~index/sentinel
|
||||
:page page :total-pages total-pages
|
||||
:current-local-href current-local-href)))))))
|
||||
|
||||
;; Sentinel for blog index infinite scroll
|
||||
(defcomp ~blog-index-sentinel (&key page total-pages current-local-href)
|
||||
(defcomp ~index/sentinel (&key page total-pages current-local-href)
|
||||
(when (< page total-pages)
|
||||
(let* ((next-url (str current-local-href "?page=" (+ page 1))))
|
||||
(~sentinel-desktop
|
||||
(~shared:misc/sentinel-desktop
|
||||
:id (str "sentinel-" page "-d")
|
||||
:next-url next-url
|
||||
:hyperscript "init if not me.dataset.retryMs then set me.dataset.retryMs to 1000 end on htmx:beforeRequest(event) add .hidden to .js-neterr in me remove .hidden from .js-loading in me remove .opacity-100 from me add .opacity-0 to me set trig to null if event.detail and event.detail.triggeringEvent then set trig to event.detail.triggeringEvent end if trig and trig.type is 'intersect' set scroller to the closest .js-grid-viewport if scroller is null then halt end if scroller.scrollTop < 20 then halt end end def backoff() set ms to me.dataset.retryMs if ms > 30000 then set ms to 30000 end add .hidden to .js-loading in me remove .hidden from .js-neterr in me remove .opacity-0 from me add .opacity-100 to me wait ms ms trigger sentinel:retry set ms to ms * 2 if ms > 30000 then set ms to 30000 end set me.dataset.retryMs to ms end on htmx:sendError call backoff() on htmx:responseError call backoff() on htmx:timeout call backoff()"))))
|
||||
|
||||
;; Blog index action buttons — replaces _action_buttons_sx
|
||||
(defcomp ~blog-index-actions (&key is-admin has-user hx-select draft-count drafts
|
||||
(defcomp ~index/actions (&key is-admin has-user hx-select draft-count drafts
|
||||
new-post-href new-page-href current-local-href)
|
||||
(~blog-action-buttons-wrapper
|
||||
(~filters/action-buttons-wrapper
|
||||
:inner (<>
|
||||
(when is-admin
|
||||
(<>
|
||||
(~blog-action-button
|
||||
(~filters/action-button
|
||||
:href new-post-href :hx-select hx-select
|
||||
:btn-class "px-3 py-1 rounded bg-stone-700 text-white text-sm hover:bg-stone-800 transition-colors"
|
||||
:title "New Post" :icon-class "fa fa-plus mr-1" :label " New Post")
|
||||
(~blog-action-button
|
||||
(~filters/action-button
|
||||
:href new-page-href :hx-select hx-select
|
||||
:btn-class "px-3 py-1 rounded bg-blue-600 text-white text-sm hover:bg-blue-700 transition-colors"
|
||||
:title "New Page" :icon-class "fa fa-plus mr-1" :label " New Page")))
|
||||
(when (and has-user (or draft-count drafts))
|
||||
(if drafts
|
||||
(~blog-drafts-button
|
||||
(~filters/drafts-button
|
||||
:href current-local-href :hx-select hx-select
|
||||
:btn-class "px-3 py-1 rounded bg-stone-700 text-white text-sm hover:bg-stone-800 transition-colors"
|
||||
:title "Hide Drafts" :label " Drafts " :draft-count (str draft-count))
|
||||
(let* ((on-href (str current-local-href
|
||||
(if (contains? current-local-href "?") "&" "?") "drafts=1")))
|
||||
(~blog-drafts-button-amber
|
||||
(~filters/drafts-button-amber
|
||||
:href on-href :hx-select hx-select
|
||||
:btn-class "px-3 py-1 rounded bg-amber-600 text-white text-sm hover:bg-amber-700 transition-colors"
|
||||
:title "Show Drafts" :label " Drafts " :draft-count (str draft-count))))))))
|
||||
|
||||
;; Tag groups filter — replaces _tag_groups_filter_sx
|
||||
(defcomp ~blog-index-tag-groups-filter (&key tag-groups is-any-group hx-select)
|
||||
(~blog-filter-nav
|
||||
(defcomp ~index/tag-groups-filter (&key tag-groups is-any-group hx-select)
|
||||
(~filters/nav
|
||||
:items (<>
|
||||
(~blog-filter-any-topic
|
||||
(~filters/any-topic
|
||||
:cls (if is-any-group
|
||||
"bg-stone-900 text-white border-stone-900"
|
||||
"bg-white text-stone-600 border-stone-300 hover:bg-stone-50")
|
||||
@@ -178,23 +178,23 @@
|
||||
(colour (get grp "colour"))
|
||||
(name (get grp "name"))
|
||||
(icon (if fi
|
||||
(~blog-filter-group-icon-image :src fi :name name)
|
||||
(~blog-filter-group-icon-color
|
||||
(~filters/group-icon-image :src fi :name name)
|
||||
(~filters/group-icon-color
|
||||
:style (if colour
|
||||
(str "background-color: " colour "; color: white;")
|
||||
"background-color: #e7e5e4; color: #57534e;")
|
||||
:initial (slice (or name "?") 0 1)))))
|
||||
(~blog-filter-group-li
|
||||
(~filters/group-li
|
||||
:cls cls :hx-get (str "?group=" (get grp "slug") "&page=1")
|
||||
:hx-select hx-select :icon icon
|
||||
:name name :count (str (get grp "post_count")))))
|
||||
(or tag-groups (list))))))
|
||||
|
||||
;; Authors filter — replaces _authors_filter_sx
|
||||
(defcomp ~blog-index-authors-filter (&key authors is-any-author hx-select)
|
||||
(~blog-filter-nav
|
||||
(defcomp ~index/authors-filter (&key authors is-any-author hx-select)
|
||||
(~filters/nav
|
||||
:items (<>
|
||||
(~blog-filter-any-author
|
||||
(~filters/any-author
|
||||
:cls (if is-any-author
|
||||
"bg-stone-900 text-white border-stone-900"
|
||||
"bg-white text-stone-600 border-stone-300 hover:bg-stone-50")
|
||||
@@ -205,49 +205,49 @@
|
||||
"bg-stone-900 text-white border-stone-900"
|
||||
"bg-white text-stone-600 border-stone-300 hover:bg-stone-50"))
|
||||
(img (get a "profile_image")))
|
||||
(~blog-filter-author-li
|
||||
(~filters/author-li
|
||||
:cls cls :hx-get (str "?author=" (get a "slug") "&page=1")
|
||||
:hx-select hx-select
|
||||
:icon (when img (~blog-filter-author-icon :src img :name (get a "name")))
|
||||
:icon (when img (~filters/author-icon :src img :name (get a "name")))
|
||||
:name (get a "name")
|
||||
:count (str (get a "published_post_count")))))
|
||||
(or authors (list))))))
|
||||
|
||||
;; Blog index aside — replaces _blog_aside_sx
|
||||
(defcomp ~blog-index-aside-content (&key is-admin has-user hx-select draft-count drafts
|
||||
(defcomp ~index/aside-content (&key is-admin has-user hx-select draft-count drafts
|
||||
new-post-href new-page-href current-local-href
|
||||
tag-groups authors is-any-group is-any-author)
|
||||
(~blog-aside
|
||||
:search (~search-desktop)
|
||||
:action-buttons (~blog-index-actions
|
||||
(~index/aside
|
||||
:search (~shared:controls/search-desktop)
|
||||
:action-buttons (~index/actions
|
||||
:is-admin is-admin :has-user has-user :hx-select hx-select
|
||||
:draft-count draft-count :drafts drafts
|
||||
:new-post-href new-post-href :new-page-href new-page-href
|
||||
:current-local-href current-local-href)
|
||||
:tag-groups-filter (~blog-index-tag-groups-filter
|
||||
:tag-groups-filter (~index/tag-groups-filter
|
||||
:tag-groups tag-groups :is-any-group is-any-group :hx-select hx-select)
|
||||
:authors-filter (~blog-index-authors-filter
|
||||
:authors-filter (~index/authors-filter
|
||||
:authors authors :is-any-author is-any-author :hx-select hx-select)))
|
||||
|
||||
;; Blog index mobile filter — replaces _blog_filter_sx
|
||||
(defcomp ~blog-index-filter-content (&key is-admin has-user hx-select draft-count drafts
|
||||
(defcomp ~index/filter-content (&key is-admin has-user hx-select draft-count drafts
|
||||
new-post-href new-page-href current-local-href
|
||||
tag-groups authors is-any-group is-any-author
|
||||
tg-summary au-summary)
|
||||
(~mobile-filter
|
||||
(~shared:controls/mobile-filter
|
||||
:filter-summary (<>
|
||||
(~search-mobile)
|
||||
(~shared:controls/search-mobile)
|
||||
(when (not (= tg-summary ""))
|
||||
(~blog-filter-summary :text tg-summary))
|
||||
(~filters/summary :text tg-summary))
|
||||
(when (not (= au-summary ""))
|
||||
(~blog-filter-summary :text au-summary)))
|
||||
:action-buttons (~blog-index-actions
|
||||
(~filters/summary :text au-summary)))
|
||||
:action-buttons (~index/actions
|
||||
:is-admin is-admin :has-user has-user :hx-select hx-select
|
||||
:draft-count draft-count :drafts drafts
|
||||
:new-post-href new-post-href :new-page-href new-page-href
|
||||
:current-local-href current-local-href)
|
||||
:filter-details (<>
|
||||
(~blog-index-tag-groups-filter
|
||||
(~index/tag-groups-filter
|
||||
:tag-groups tag-groups :is-any-group is-any-group :hx-select hx-select)
|
||||
(~blog-index-authors-filter
|
||||
(~index/authors-filter
|
||||
:authors authors :is-any-author is-any-author :hx-select hx-select))))
|
||||
|
||||
@@ -7,7 +7,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Image card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-image (&key src alt caption width href)
|
||||
(defcomp ~kg_cards/kg-image (&key (src :as string) (alt :as string?) (caption :as string?) (width :as string?) (href :as string?))
|
||||
(figure :class (str "kg-card kg-image-card"
|
||||
(if (= width "wide") " kg-width-wide"
|
||||
(if (= width "full") " kg-width-full" "")))
|
||||
@@ -19,7 +19,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Gallery card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-gallery (&key images caption)
|
||||
(defcomp ~kg_cards/kg-gallery (&key (images :as list) (caption :as string?))
|
||||
(figure :class "kg-card kg-gallery-card kg-width-wide"
|
||||
(div :class "kg-gallery-container"
|
||||
(map (lambda (row)
|
||||
@@ -36,19 +36,19 @@
|
||||
;; HTML card — wraps user-pasted HTML so the editor can identify the block.
|
||||
;; Content is native sx children (no longer an opaque HTML string).
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-html (&rest children)
|
||||
(defcomp ~kg_cards/kg-html (&rest children)
|
||||
(div :class "kg-card kg-html-card" children))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Markdown card — rendered markdown content, editor can identify the block.
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-md (&rest children)
|
||||
(defcomp ~kg_cards/kg-md (&rest children)
|
||||
(div :class "kg-card kg-md-card" children))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Embed card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-embed (&key html caption)
|
||||
(defcomp ~kg_cards/kg-embed (&key (html :as string) (caption :as string?))
|
||||
(figure :class "kg-card kg-embed-card"
|
||||
(~rich-text :html html)
|
||||
(when caption (figcaption caption))))
|
||||
@@ -56,7 +56,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Bookmark card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-bookmark (&key url title description icon author publisher thumbnail caption)
|
||||
(defcomp ~kg_cards/kg-bookmark (&key (url :as string) (title :as string?) (description :as string?) (icon :as string?) (author :as string?) (publisher :as string?) (thumbnail :as string?) (caption :as string?))
|
||||
(figure :class "kg-card kg-bookmark-card"
|
||||
(a :class "kg-bookmark-container" :href url
|
||||
(div :class "kg-bookmark-content"
|
||||
@@ -75,7 +75,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Callout card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-callout (&key color emoji content)
|
||||
(defcomp ~kg_cards/kg-callout (&key (color :as string?) (emoji :as string?) (content :as string?))
|
||||
(div :class (str "kg-card kg-callout-card kg-callout-card-" (or color "grey"))
|
||||
(when emoji (div :class "kg-callout-emoji" emoji))
|
||||
(div :class "kg-callout-text" (or content ""))))
|
||||
@@ -83,14 +83,14 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Button card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-button (&key url text alignment)
|
||||
(defcomp ~kg_cards/kg-button (&key (url :as string) (text :as string?) (alignment :as string?))
|
||||
(div :class (str "kg-card kg-button-card kg-align-" (or alignment "center"))
|
||||
(a :href url :class "kg-btn kg-btn-accent" (or text ""))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Toggle card (accordion)
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-toggle (&key heading content)
|
||||
(defcomp ~kg_cards/kg-toggle (&key (heading :as string?) (content :as string?))
|
||||
(div :class "kg-card kg-toggle-card" :data-kg-toggle-state "close"
|
||||
(div :class "kg-toggle-heading"
|
||||
(h4 :class "kg-toggle-heading-text" (or heading ""))
|
||||
@@ -101,7 +101,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Audio card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-audio (&key src title duration thumbnail)
|
||||
(defcomp ~kg_cards/kg-audio (&key (src :as string) (title :as string?) (duration :as string?) (thumbnail :as string?))
|
||||
(div :class "kg-card kg-audio-card"
|
||||
(if thumbnail
|
||||
(img :src thumbnail :alt "audio-thumbnail" :class "kg-audio-thumbnail")
|
||||
@@ -124,7 +124,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Video card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-video (&key src caption width thumbnail loop)
|
||||
(defcomp ~kg_cards/kg-video (&key (src :as string) (caption :as string?) (width :as string?) (thumbnail :as string?) (loop :as boolean?))
|
||||
(figure :class (str "kg-card kg-video-card"
|
||||
(if (= width "wide") " kg-width-wide"
|
||||
(if (= width "full") " kg-width-full" "")))
|
||||
@@ -136,7 +136,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; File card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-file (&key src filename title filesize caption)
|
||||
(defcomp ~kg_cards/kg-file (&key (src :as string) (filename :as string?) (title :as string?) (filesize :as string?) (caption :as string?))
|
||||
(div :class "kg-card kg-file-card"
|
||||
(a :class "kg-file-card-container" :href src :download (or filename "")
|
||||
(div :class "kg-file-card-contents"
|
||||
@@ -149,5 +149,5 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Paywall marker
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-paywall ()
|
||||
(defcomp ~kg_cards/kg-paywall ()
|
||||
(~rich-text :html "<!--members-only-->"))
|
||||
|
||||
@@ -3,8 +3,8 @@
|
||||
|
||||
;; --- Blog header (invisible row for blog-header-child swap target) ---
|
||||
|
||||
(defcomp ~blog-header (&key oob)
|
||||
(~menu-row-sx :id "blog-row" :level 1
|
||||
(defcomp ~layouts/header (&key oob)
|
||||
(~shared:layout/menu-row-sx :id "blog-row" :level 1
|
||||
:link-label-content (div)
|
||||
:child-id "blog-header-child" :oob oob))
|
||||
|
||||
@@ -12,10 +12,10 @@
|
||||
|
||||
(defmacro ~blog-settings-header-auto (oob)
|
||||
(quasiquote
|
||||
(~menu-row-sx :id "root-settings-row" :level 1
|
||||
(~shared:layout/menu-row-sx :id "root-settings-row" :level 1
|
||||
:link-href (url-for "settings.defpage_settings_home")
|
||||
:link-label-content (~blog-admin-label)
|
||||
:nav (~blog-settings-nav)
|
||||
:link-label-content (~header/admin-label)
|
||||
:nav (~layouts/settings-nav)
|
||||
:child-id "root-settings-header-child"
|
||||
:oob (unquote oob))))
|
||||
|
||||
@@ -23,9 +23,9 @@
|
||||
|
||||
(defmacro ~blog-sub-settings-header-auto (row-id child-id endpoint icon label oob)
|
||||
(quasiquote
|
||||
(~menu-row-sx :id (unquote row-id) :level 2
|
||||
(~shared:layout/menu-row-sx :id (unquote row-id) :level 2
|
||||
:link-href (url-for (unquote endpoint))
|
||||
:link-label-content (~blog-sub-settings-label
|
||||
:link-label-content (~header/sub-settings-label
|
||||
:icon (str "fa fa-" (unquote icon))
|
||||
:label (unquote label))
|
||||
:child-id (unquote child-id)
|
||||
@@ -35,47 +35,47 @@
|
||||
;; Blog layout (root + blog header)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-layout-full ()
|
||||
(defcomp ~layouts/full ()
|
||||
(<> (~root-header-auto)
|
||||
(~blog-header)))
|
||||
(~layouts/header)))
|
||||
|
||||
(defcomp ~blog-layout-oob ()
|
||||
(<> (~blog-header :oob true)
|
||||
(~clear-oob-div :id "blog-header-child")
|
||||
(defcomp ~layouts/oob ()
|
||||
(<> (~layouts/header :oob true)
|
||||
(~shared:layout/clear-oob-div :id "blog-header-child")
|
||||
(~root-header-auto true)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Settings layout (root + settings header)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-settings-layout-full ()
|
||||
(defcomp ~layouts/settings-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~blog-settings-header-auto)))
|
||||
|
||||
(defcomp ~blog-settings-layout-oob ()
|
||||
(defcomp ~layouts/settings-layout-oob ()
|
||||
(<> (~blog-settings-header-auto true)
|
||||
(~clear-oob-div :id "root-settings-header-child")
|
||||
(~shared:layout/clear-oob-div :id "root-settings-header-child")
|
||||
(~root-header-auto true)))
|
||||
|
||||
(defcomp ~blog-settings-layout-mobile ()
|
||||
(~blog-settings-nav))
|
||||
(defcomp ~layouts/settings-layout-mobile ()
|
||||
(~layouts/settings-nav))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Cache layout (root + settings + cache sub-header)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-cache-layout-full ()
|
||||
(defcomp ~layouts/cache-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~blog-settings-header-auto)
|
||||
(~blog-sub-settings-header-auto
|
||||
"cache-row" "cache-header-child"
|
||||
"settings.defpage_cache_page" "refresh" "Cache")))
|
||||
|
||||
(defcomp ~blog-cache-layout-oob ()
|
||||
(defcomp ~layouts/cache-layout-oob ()
|
||||
(<> (~blog-sub-settings-header-auto
|
||||
"cache-row" "cache-header-child"
|
||||
"settings.defpage_cache_page" "refresh" "Cache" true)
|
||||
(~clear-oob-div :id "cache-header-child")
|
||||
(~shared:layout/clear-oob-div :id "cache-header-child")
|
||||
(~blog-settings-header-auto true)
|
||||
(~root-header-auto true)))
|
||||
|
||||
@@ -83,18 +83,18 @@
|
||||
;; Snippets layout (root + settings + snippets sub-header)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-snippets-layout-full ()
|
||||
(defcomp ~layouts/snippets-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~blog-settings-header-auto)
|
||||
(~blog-sub-settings-header-auto
|
||||
"snippets-row" "snippets-header-child"
|
||||
"snippets.defpage_snippets_page" "puzzle-piece" "Snippets")))
|
||||
|
||||
(defcomp ~blog-snippets-layout-oob ()
|
||||
(defcomp ~layouts/snippets-layout-oob ()
|
||||
(<> (~blog-sub-settings-header-auto
|
||||
"snippets-row" "snippets-header-child"
|
||||
"snippets.defpage_snippets_page" "puzzle-piece" "Snippets" true)
|
||||
(~clear-oob-div :id "snippets-header-child")
|
||||
(~shared:layout/clear-oob-div :id "snippets-header-child")
|
||||
(~blog-settings-header-auto true)
|
||||
(~root-header-auto true)))
|
||||
|
||||
@@ -102,18 +102,18 @@
|
||||
;; Menu Items layout (root + settings + menu-items sub-header)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-menu-items-layout-full ()
|
||||
(defcomp ~layouts/menu-items-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~blog-settings-header-auto)
|
||||
(~blog-sub-settings-header-auto
|
||||
"menu_items-row" "menu_items-header-child"
|
||||
"menu_items.defpage_menu_items_page" "bars" "Menu Items")))
|
||||
|
||||
(defcomp ~blog-menu-items-layout-oob ()
|
||||
(defcomp ~layouts/menu-items-layout-oob ()
|
||||
(<> (~blog-sub-settings-header-auto
|
||||
"menu_items-row" "menu_items-header-child"
|
||||
"menu_items.defpage_menu_items_page" "bars" "Menu Items" true)
|
||||
(~clear-oob-div :id "menu_items-header-child")
|
||||
(~shared:layout/clear-oob-div :id "menu_items-header-child")
|
||||
(~blog-settings-header-auto true)
|
||||
(~root-header-auto true)))
|
||||
|
||||
@@ -121,18 +121,18 @@
|
||||
;; Tag Groups layout (root + settings + tag-groups sub-header)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-tag-groups-layout-full ()
|
||||
(defcomp ~layouts/tag-groups-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~blog-settings-header-auto)
|
||||
(~blog-sub-settings-header-auto
|
||||
"tag-groups-row" "tag-groups-header-child"
|
||||
"blog.tag_groups_admin.defpage_tag_groups_page" "tags" "Tag Groups")))
|
||||
|
||||
(defcomp ~blog-tag-groups-layout-oob ()
|
||||
(defcomp ~layouts/tag-groups-layout-oob ()
|
||||
(<> (~blog-sub-settings-header-auto
|
||||
"tag-groups-row" "tag-groups-header-child"
|
||||
"blog.tag_groups_admin.defpage_tag_groups_page" "tags" "Tag Groups" true)
|
||||
(~clear-oob-div :id "tag-groups-header-child")
|
||||
(~shared:layout/clear-oob-div :id "tag-groups-header-child")
|
||||
(~blog-settings-header-auto true)
|
||||
(~root-header-auto true)))
|
||||
|
||||
@@ -140,31 +140,31 @@
|
||||
;; Tag Group Edit layout (root + settings + tag-groups sub-header with id)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-tag-group-edit-layout-full ()
|
||||
(defcomp ~layouts/tag-group-edit-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~blog-settings-header-auto)
|
||||
(~menu-row-sx :id "tag-groups-row" :level 2
|
||||
(~shared:layout/menu-row-sx :id "tag-groups-row" :level 2
|
||||
:link-href (url-for "blog.tag_groups_admin.defpage_tag_group_edit"
|
||||
:id (request-view-args "id"))
|
||||
:link-label-content (~blog-sub-settings-label
|
||||
:link-label-content (~header/sub-settings-label
|
||||
:icon "fa fa-tags" :label "Tag Groups")
|
||||
:child-id "tag-groups-header-child")))
|
||||
|
||||
(defcomp ~blog-tag-group-edit-layout-oob ()
|
||||
(<> (~menu-row-sx :id "tag-groups-row" :level 2
|
||||
(defcomp ~layouts/tag-group-edit-layout-oob ()
|
||||
(<> (~shared:layout/menu-row-sx :id "tag-groups-row" :level 2
|
||||
:link-href (url-for "blog.tag_groups_admin.defpage_tag_group_edit"
|
||||
:id (request-view-args "id"))
|
||||
:link-label-content (~blog-sub-settings-label
|
||||
:link-label-content (~header/sub-settings-label
|
||||
:icon "fa fa-tags" :label "Tag Groups")
|
||||
:child-id "tag-groups-header-child"
|
||||
:oob true)
|
||||
(~clear-oob-div :id "tag-groups-header-child")
|
||||
(~shared:layout/clear-oob-div :id "tag-groups-header-child")
|
||||
(~blog-settings-header-auto true)
|
||||
(~root-header-auto true)))
|
||||
|
||||
;; --- Settings nav links — uses IO primitives ---
|
||||
|
||||
(defcomp ~blog-settings-nav ()
|
||||
(defcomp ~layouts/settings-nav ()
|
||||
(let* ((sc (select-colours))
|
||||
(links (list
|
||||
(dict :endpoint "menu_items.defpage_menu_items_page" :icon "fa fa-bars" :label "Menu Items")
|
||||
@@ -172,7 +172,7 @@
|
||||
(dict :endpoint "blog.tag_groups_admin.defpage_tag_groups_page" :icon "fa fa-tags" :label "Tag Groups")
|
||||
(dict :endpoint "settings.defpage_cache_page" :icon "fa fa-refresh" :label "Cache"))))
|
||||
(<> (map (lambda (lnk)
|
||||
(~nav-link
|
||||
(~shared:layout/nav-link
|
||||
:href (url-for (get lnk "endpoint"))
|
||||
:icon (get lnk "icon")
|
||||
:label (get lnk "label")
|
||||
@@ -181,5 +181,5 @@
|
||||
|
||||
;; --- Editor panel wrapper ---
|
||||
|
||||
(defcomp ~blog-editor-panel (&key parts)
|
||||
(defcomp ~layouts/editor-panel (&key parts)
|
||||
(<> parts))
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Menu item form and page search components
|
||||
|
||||
(defcomp ~page-search-item (&key id title slug feature-image)
|
||||
(defcomp ~menu_items/page-search-item (&key id title slug feature-image)
|
||||
(div :class "flex items-center gap-3 p-3 hover:bg-stone-50 cursor-pointer border-b last:border-b-0"
|
||||
:data-page-id id :data-page-title title :data-page-slug slug
|
||||
:data-page-image (or feature-image "")
|
||||
@@ -11,50 +11,50 @@
|
||||
(div :class "font-medium truncate" title)
|
||||
(div :class "text-xs text-stone-500 truncate" slug))))
|
||||
|
||||
(defcomp ~page-search-results (&key items sentinel)
|
||||
(defcomp ~menu_items/page-search-results (&key items sentinel)
|
||||
(div :class "border border-stone-200 rounded-md max-h-64 overflow-y-auto"
|
||||
items sentinel))
|
||||
|
||||
(defcomp ~page-search-sentinel (&key url query next-page)
|
||||
(defcomp ~menu_items/page-search-sentinel (&key url query next-page)
|
||||
(div :sx-get url :sx-trigger "intersect once" :sx-swap "outerHTML"
|
||||
:sx-vals (str "{\"q\": \"" query "\", \"page\": " next-page "}")
|
||||
:class "p-3 text-center text-sm text-stone-400"
|
||||
(i :class "fa fa-spinner fa-spin") " Loading more..."))
|
||||
|
||||
(defcomp ~page-search-empty (&key query)
|
||||
(defcomp ~menu_items/page-search-empty (&key query)
|
||||
(div :class "p-3 text-center text-stone-400 border border-stone-200 rounded-md"
|
||||
(str "No pages found matching \"" query "\"")))
|
||||
|
||||
;; Data-driven page search results (replaces Python render_page_search_results loop)
|
||||
(defcomp ~page-search-results-from-data (&key pages query has-more search-url next-page)
|
||||
(defcomp ~menu_items/page-search-results-from-data (&key pages query has-more search-url next-page)
|
||||
(if (and (not pages) query)
|
||||
(~page-search-empty :query query)
|
||||
(~menu_items/page-search-empty :query query)
|
||||
(when pages
|
||||
(~page-search-results
|
||||
(~menu_items/page-search-results
|
||||
:items (<> (map (lambda (p)
|
||||
(~page-search-item
|
||||
(~menu_items/page-search-item
|
||||
:id (get p "id") :title (get p "title")
|
||||
:slug (get p "slug") :feature-image (get p "feature_image")))
|
||||
pages))
|
||||
:sentinel (when has-more
|
||||
(~page-search-sentinel :url search-url :query query :next-page next-page))))))
|
||||
(~menu_items/page-search-sentinel :url search-url :query query :next-page next-page))))))
|
||||
|
||||
;; Data-driven menu nav items (replaces Python render_menu_items_nav_oob loop)
|
||||
(defcomp ~blog-menu-nav-from-data (&key items nav-cls container-id arrow-cls scroll-hs)
|
||||
(defcomp ~menu_items/menu-nav-from-data (&key items nav-cls container-id arrow-cls scroll-hs)
|
||||
(if (not items)
|
||||
(~blog-nav-empty :wrapper-id "menu-items-nav-wrapper")
|
||||
(~scroll-nav-wrapper :wrapper-id "menu-items-nav-wrapper" :container-id container-id
|
||||
(~shared:nav/blog-nav-empty :wrapper-id "menu-items-nav-wrapper")
|
||||
(~shared:misc/scroll-nav-wrapper :wrapper-id "menu-items-nav-wrapper" :container-id container-id
|
||||
:arrow-cls arrow-cls
|
||||
:left-hs (str "on click set #" container-id ".scrollLeft to #" container-id ".scrollLeft - 200")
|
||||
:scroll-hs scroll-hs
|
||||
:right-hs (str "on click set #" container-id ".scrollLeft to #" container-id ".scrollLeft + 200")
|
||||
:items (<> (map (lambda (item)
|
||||
(let* ((img (~img-or-placeholder :src (get item "feature_image") :alt (get item "label")
|
||||
(let* ((img (~shared:misc/img-or-placeholder :src (get item "feature_image") :alt (get item "label")
|
||||
:size-cls "w-8 h-8 rounded-full object-cover flex-shrink-0")))
|
||||
(if (= (get item "slug") "cart")
|
||||
(~blog-nav-item-plain :href (get item "href") :selected (get item "selected")
|
||||
(~shared:nav/blog-nav-item-plain :href (get item "href") :selected (get item "selected")
|
||||
:nav-cls nav-cls :img img :label (get item "label"))
|
||||
(~blog-nav-item-link :href (get item "href") :hx-get (get item "hx_get")
|
||||
(~shared:nav/blog-nav-item-link :href (get item "href") :hx-get (get item "hx_get")
|
||||
:selected (get item "selected") :nav-cls nav-cls :img img :label (get item "label")))))
|
||||
items))
|
||||
:oob true)))
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Blog settings panel components (features, markets, associated entries)
|
||||
|
||||
(defcomp ~blog-features-form (&key features-url calendar-checked market-checked hs-trigger)
|
||||
(defcomp ~settings/features-form (&key (features-url :as string) (calendar-checked :as boolean) (market-checked :as boolean) (hs-trigger :as string))
|
||||
(form :sx-put features-url :sx-target "#features-panel" :sx-swap "outerHTML"
|
||||
:sx-headers {:Content-Type "application/json"} :sx-encoding "json" :class "space-y-3"
|
||||
(label :class "flex items-center gap-3 cursor-pointer"
|
||||
@@ -18,33 +18,33 @@
|
||||
(i :class "fa fa-shopping-bag text-green-600 mr-1")
|
||||
" Market \u2014 enable product catalog on this page"))))
|
||||
|
||||
(defcomp ~blog-sumup-form (&key sumup-url merchant-code placeholder sumup-configured checkout-prefix)
|
||||
(defcomp ~settings/sumup-form (&key sumup-url merchant-code placeholder sumup-configured checkout-prefix)
|
||||
(div :class "mt-4 pt-4 border-t border-stone-100"
|
||||
(~sumup-settings-form :update-url sumup-url :merchant-code merchant-code
|
||||
(~shared:misc/sumup-settings-form :update-url sumup-url :merchant-code merchant-code
|
||||
:placeholder placeholder :sumup-configured sumup-configured
|
||||
:checkout-prefix checkout-prefix :panel-id "features-panel")))
|
||||
|
||||
(defcomp ~blog-features-panel (&key form sumup)
|
||||
(defcomp ~settings/features-panel (&key form sumup)
|
||||
(div :id "features-panel" :class "space-y-4 p-4 bg-white rounded-lg border border-stone-200"
|
||||
(h3 :class "text-lg font-semibold text-stone-800" "Page Features")
|
||||
form sumup))
|
||||
|
||||
;; Markets panel
|
||||
|
||||
(defcomp ~blog-market-item (&key name slug delete-url confirm-text)
|
||||
(defcomp ~settings/market-item (&key (name :as string) (slug :as string) (delete-url :as string) (confirm-text :as string))
|
||||
(li :class "flex items-center justify-between p-3 bg-stone-50 rounded"
|
||||
(div (span :class "font-medium" name)
|
||||
(span :class "text-stone-400 text-sm ml-2" (str "/" slug "/")))
|
||||
(button :sx-delete delete-url :sx-target "#markets-panel" :sx-swap "outerHTML"
|
||||
:sx-confirm confirm-text :class "text-red-600 hover:text-red-800 text-sm" "Delete")))
|
||||
|
||||
(defcomp ~blog-markets-list (&key items)
|
||||
(defcomp ~settings/markets-list (&key items)
|
||||
(ul :class "space-y-2 mb-4" items))
|
||||
|
||||
(defcomp ~blog-markets-empty ()
|
||||
(defcomp ~settings/markets-empty ()
|
||||
(p :class "text-stone-500 mb-4 text-sm" "No markets yet."))
|
||||
|
||||
(defcomp ~blog-markets-panel (&key list create-url)
|
||||
(defcomp ~settings/markets-panel (&key list create-url)
|
||||
(div :id "markets-panel"
|
||||
(h3 :class "text-lg font-semibold mb-3" "Markets")
|
||||
list
|
||||
@@ -59,17 +59,17 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Features panel composition — replaces render_features_panel
|
||||
(defcomp ~blog-features-panel-content (&key features-url calendar-checked market-checked
|
||||
(defcomp ~settings/features-panel-content (&key features-url calendar-checked market-checked
|
||||
show-sumup sumup-url merchant-code placeholder
|
||||
sumup-configured checkout-prefix)
|
||||
(~blog-features-panel
|
||||
:form (~blog-features-form
|
||||
(~settings/features-panel
|
||||
:form (~settings/features-form
|
||||
:features-url features-url
|
||||
:calendar-checked calendar-checked
|
||||
:market-checked market-checked
|
||||
:hs-trigger "on change trigger submit on closest <form/>")
|
||||
:sumup (when show-sumup
|
||||
(~blog-sumup-form
|
||||
(~settings/sumup-form
|
||||
:sumup-url sumup-url
|
||||
:merchant-code merchant-code
|
||||
:placeholder placeholder
|
||||
@@ -77,13 +77,13 @@
|
||||
:checkout-prefix checkout-prefix))))
|
||||
|
||||
;; Markets panel composition — replaces render_markets_panel
|
||||
(defcomp ~blog-markets-panel-content (&key markets create-url)
|
||||
(~blog-markets-panel
|
||||
(defcomp ~settings/markets-panel-content (&key markets create-url)
|
||||
(~settings/markets-panel
|
||||
:list (if (empty? (or markets (list)))
|
||||
(~blog-markets-empty)
|
||||
(~blog-markets-list
|
||||
(~settings/markets-empty)
|
||||
(~settings/markets-list
|
||||
:items (map (lambda (m)
|
||||
(~blog-market-item
|
||||
(~settings/market-item
|
||||
:name (get m "name")
|
||||
:slug (get m "slug")
|
||||
:delete-url (get m "delete_url")
|
||||
@@ -93,11 +93,11 @@
|
||||
|
||||
;; Associated entries
|
||||
|
||||
(defcomp ~blog-entry-image (&key src title)
|
||||
(defcomp ~settings/entry-image (&key (src :as string?) (title :as string))
|
||||
(if src (img :src src :alt title :class "w-8 h-8 rounded-full object-cover flex-shrink-0")
|
||||
(div :class "w-8 h-8 rounded-full bg-stone-200 flex-shrink-0")))
|
||||
|
||||
(defcomp ~blog-associated-entry (&key confirm-text toggle-url hx-headers img name date-str)
|
||||
(defcomp ~settings/associated-entry (&key (confirm-text :as string) (toggle-url :as string) hx-headers img (name :as string) (date-str :as string))
|
||||
(button :type "button"
|
||||
:class "w-full text-left p-3 rounded border bg-green-50 border-green-300 transition hover:bg-green-100"
|
||||
:data-confirm "" :data-confirm-title "Remove entry?"
|
||||
@@ -115,14 +115,14 @@
|
||||
(div :class "text-xs text-stone-600 mt-1" date-str))
|
||||
(i :class "fa fa-times-circle text-green-600 text-lg flex-shrink-0"))))
|
||||
|
||||
(defcomp ~blog-associated-entries-content (&key items)
|
||||
(defcomp ~settings/associated-entries-content (&key items)
|
||||
(div :class "space-y-1" items))
|
||||
|
||||
(defcomp ~blog-associated-entries-empty ()
|
||||
(defcomp ~settings/associated-entries-empty ()
|
||||
(div :class "text-sm text-stone-400"
|
||||
"No entries associated yet. Browse calendars below to add entries."))
|
||||
|
||||
(defcomp ~blog-associated-entries-panel (&key content)
|
||||
(defcomp ~settings/associated-entries-panel (&key content)
|
||||
(div :id "associated-entries-list" :class "border rounded-lg p-4 bg-white"
|
||||
(h3 :class "text-lg font-semibold mb-4" "Associated Entries")
|
||||
content))
|
||||
@@ -131,17 +131,17 @@
|
||||
;; Associated entries composition — replaces _render_associated_entries
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-associated-entries-from-data (&key entries csrf)
|
||||
(~blog-associated-entries-panel
|
||||
(defcomp ~settings/associated-entries-from-data (&key entries csrf)
|
||||
(~settings/associated-entries-panel
|
||||
:content (if (empty? (or entries (list)))
|
||||
(~blog-associated-entries-empty)
|
||||
(~blog-associated-entries-content
|
||||
(~settings/associated-entries-empty)
|
||||
(~settings/associated-entries-content
|
||||
:items (map (lambda (e)
|
||||
(~blog-associated-entry
|
||||
(~settings/associated-entry
|
||||
:confirm-text (get e "confirm_text")
|
||||
:toggle-url (get e "toggle_url")
|
||||
:hx-headers {:X-CSRFToken csrf}
|
||||
:img (~blog-entry-image :src (get e "cal_image") :title (get e "cal_title"))
|
||||
:img (~settings/entry-image :src (get e "cal_image") :title (get e "cal_title"))
|
||||
:name (get e "name")
|
||||
:date-str (get e "date_str")))
|
||||
(or entries (list)))))))
|
||||
@@ -150,7 +150,7 @@
|
||||
;; Entries browser composition — replaces _h_post_entries_content
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-calendar-browser-item (&key name title image view-url)
|
||||
(defcomp ~settings/calendar-browser-item (&key (name :as string) (title :as string) (image :as string?) (view-url :as string))
|
||||
(details :class "border rounded-lg bg-white" :data-toggle-group "calendar-browser"
|
||||
(summary :class "p-4 cursor-pointer hover:bg-stone-50 flex items-center gap-3"
|
||||
(if image
|
||||
@@ -163,7 +163,7 @@
|
||||
(div :class "p-4 border-t" :sx-get view-url :sx-trigger "intersect once" :sx-swap "innerHTML"
|
||||
(div :class "text-sm text-stone-400" "Loading calendar..."))))
|
||||
|
||||
(defcomp ~blog-entries-browser-content (&key entries-panel calendars)
|
||||
(defcomp ~settings/entries-browser-content (&key entries-panel calendars)
|
||||
(div :id "post-entries-content" :class "space-y-6 p-4"
|
||||
entries-panel
|
||||
(div :class "space-y-3"
|
||||
@@ -171,7 +171,7 @@
|
||||
(if (empty? (or calendars (list)))
|
||||
(div :class "text-sm text-stone-400" "No calendars found.")
|
||||
(map (lambda (cal)
|
||||
(~blog-calendar-browser-item
|
||||
(~settings/calendar-browser-item
|
||||
:name (get cal "name")
|
||||
:title (get cal "title")
|
||||
:image (get cal "image")
|
||||
@@ -182,17 +182,17 @@
|
||||
;; Post settings form composition — replaces _h_post_settings_content
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-settings-field-label (&key text field-for)
|
||||
(defcomp ~settings/field-label (&key (text :as string) (field-for :as string))
|
||||
(label :for field-for
|
||||
:class "block text-[13px] font-medium text-stone-500 mb-[4px]" text))
|
||||
|
||||
(defcomp ~blog-settings-section (&key title content is-open)
|
||||
(defcomp ~settings/section (&key (title :as string) content (is-open :as boolean))
|
||||
(details :class "border border-stone-200 rounded-[8px] overflow-hidden" :open is-open
|
||||
(summary :class "px-[16px] py-[10px] bg-stone-50 text-[14px] font-medium text-stone-600 cursor-pointer select-none hover:bg-stone-100 transition-colors"
|
||||
title)
|
||||
(div :class "px-[16px] py-[12px] space-y-[12px]" content)))
|
||||
|
||||
(defcomp ~blog-settings-form-content (&key csrf updated-at is-page save-success
|
||||
(defcomp ~settings/form-content (&key csrf updated-at is-page save-success
|
||||
slug published-at featured visibility email-only
|
||||
tags feature-image-alt
|
||||
meta-title meta-description canonical-url
|
||||
@@ -209,19 +209,19 @@
|
||||
(input :type "hidden" :name "updated_at" :value (or updated-at ""))
|
||||
(div :class "space-y-[12px] mt-[16px]"
|
||||
;; General
|
||||
(~blog-settings-section :title "General" :is-open true :content
|
||||
(~settings/section :title "General" :is-open true :content
|
||||
(<>
|
||||
(div (~blog-settings-field-label :text "Slug" :field-for "settings-slug")
|
||||
(div (~settings/field-label :text "Slug" :field-for "settings-slug")
|
||||
(input :type "text" :name "slug" :id "settings-slug" :value (or slug "")
|
||||
:placeholder slug-placeholder :class input-cls))
|
||||
(div (~blog-settings-field-label :text "Published at" :field-for "settings-published_at")
|
||||
(div (~settings/field-label :text "Published at" :field-for "settings-published_at")
|
||||
(input :type "datetime-local" :name "published_at" :id "settings-published_at"
|
||||
:value (or published-at "") :class input-cls))
|
||||
(div (label :class "inline-flex items-center gap-[8px] cursor-pointer"
|
||||
(input :type "checkbox" :name "featured" :id "settings-featured" :checked featured
|
||||
:class "rounded border-stone-300 text-stone-600 focus:ring-stone-300")
|
||||
(span :class "text-[14px] text-stone-600" featured-label)))
|
||||
(div (~blog-settings-field-label :text "Visibility" :field-for "settings-visibility")
|
||||
(div (~settings/field-label :text "Visibility" :field-for "settings-visibility")
|
||||
(select :name "visibility" :id "settings-visibility" :class input-cls
|
||||
(option :value "public" :selected (= visibility "public") "Public")
|
||||
(option :value "members" :selected (= visibility "members") "Members")
|
||||
@@ -231,57 +231,57 @@
|
||||
:class "rounded border-stone-300 text-stone-600 focus:ring-stone-300")
|
||||
(span :class "text-[14px] text-stone-600" "Email only")))))
|
||||
;; Tags
|
||||
(~blog-settings-section :title "Tags" :content
|
||||
(div (~blog-settings-field-label :text "Tags (comma-separated)" :field-for "settings-tags")
|
||||
(~settings/section :title "Tags" :content
|
||||
(div (~settings/field-label :text "Tags (comma-separated)" :field-for "settings-tags")
|
||||
(input :type "text" :name "tags" :id "settings-tags" :value (or tags "")
|
||||
:placeholder "news, updates, featured" :class input-cls)
|
||||
(p :class "text-[12px] text-stone-400 mt-[4px]" "Unknown tags will be created automatically.")))
|
||||
;; Feature Image
|
||||
(~blog-settings-section :title "Feature Image" :content
|
||||
(div (~blog-settings-field-label :text "Alt text" :field-for "settings-feature_image_alt")
|
||||
(~settings/section :title "Feature Image" :content
|
||||
(div (~settings/field-label :text "Alt text" :field-for "settings-feature_image_alt")
|
||||
(input :type "text" :name "feature_image_alt" :id "settings-feature_image_alt"
|
||||
:value (or feature-image-alt "") :placeholder "Describe the feature image" :class input-cls)))
|
||||
;; SEO / Meta
|
||||
(~blog-settings-section :title "SEO / Meta" :content
|
||||
(~settings/section :title "SEO / Meta" :content
|
||||
(<>
|
||||
(div (~blog-settings-field-label :text "Meta title" :field-for "settings-meta_title")
|
||||
(div (~settings/field-label :text "Meta title" :field-for "settings-meta_title")
|
||||
(input :type "text" :name "meta_title" :id "settings-meta_title" :value (or meta-title "")
|
||||
:placeholder "SEO title" :maxlength "300" :class input-cls)
|
||||
(p :class "text-[12px] text-stone-400 mt-[2px]" "Recommended: 70 characters. Max: 300."))
|
||||
(div (~blog-settings-field-label :text "Meta description" :field-for "settings-meta_description")
|
||||
(div (~settings/field-label :text "Meta description" :field-for "settings-meta_description")
|
||||
(textarea :name "meta_description" :id "settings-meta_description" :rows "2"
|
||||
:placeholder "SEO description" :maxlength "500" :class textarea-cls
|
||||
(or meta-description ""))
|
||||
(p :class "text-[12px] text-stone-400 mt-[2px]" "Recommended: 156 characters."))
|
||||
(div (~blog-settings-field-label :text "Canonical URL" :field-for "settings-canonical_url")
|
||||
(div (~settings/field-label :text "Canonical URL" :field-for "settings-canonical_url")
|
||||
(input :type "url" :name "canonical_url" :id "settings-canonical_url"
|
||||
:value (or canonical-url "") :placeholder "https://example.com/original-post" :class input-cls))))
|
||||
;; Facebook / OpenGraph
|
||||
(~blog-settings-section :title "Facebook / OpenGraph" :content
|
||||
(~settings/section :title "Facebook / OpenGraph" :content
|
||||
(<>
|
||||
(div (~blog-settings-field-label :text "OG title" :field-for "settings-og_title")
|
||||
(div (~settings/field-label :text "OG title" :field-for "settings-og_title")
|
||||
(input :type "text" :name "og_title" :id "settings-og_title" :value (or og-title "") :class input-cls))
|
||||
(div (~blog-settings-field-label :text "OG description" :field-for "settings-og_description")
|
||||
(div (~settings/field-label :text "OG description" :field-for "settings-og_description")
|
||||
(textarea :name "og_description" :id "settings-og_description" :rows "2" :class textarea-cls
|
||||
(or og-description "")))
|
||||
(div (~blog-settings-field-label :text "OG image URL" :field-for "settings-og_image")
|
||||
(div (~settings/field-label :text "OG image URL" :field-for "settings-og_image")
|
||||
(input :type "url" :name "og_image" :id "settings-og_image" :value (or og-image "")
|
||||
:placeholder "https://..." :class input-cls))))
|
||||
;; X / Twitter
|
||||
(~blog-settings-section :title "X / Twitter" :content
|
||||
(~settings/section :title "X / Twitter" :content
|
||||
(<>
|
||||
(div (~blog-settings-field-label :text "Twitter title" :field-for "settings-twitter_title")
|
||||
(div (~settings/field-label :text "Twitter title" :field-for "settings-twitter_title")
|
||||
(input :type "text" :name "twitter_title" :id "settings-twitter_title"
|
||||
:value (or twitter-title "") :class input-cls))
|
||||
(div (~blog-settings-field-label :text "Twitter description" :field-for "settings-twitter_description")
|
||||
(div (~settings/field-label :text "Twitter description" :field-for "settings-twitter_description")
|
||||
(textarea :name "twitter_description" :id "settings-twitter_description" :rows "2" :class textarea-cls
|
||||
(or twitter-description "")))
|
||||
(div (~blog-settings-field-label :text "Twitter image URL" :field-for "settings-twitter_image")
|
||||
(div (~settings/field-label :text "Twitter image URL" :field-for "settings-twitter_image")
|
||||
(input :type "url" :name "twitter_image" :id "settings-twitter_image"
|
||||
:value (or twitter-image "") :placeholder "https://..." :class input-cls))))
|
||||
;; Advanced
|
||||
(~blog-settings-section :title "Advanced" :content
|
||||
(div (~blog-settings-field-label :text "Custom template" :field-for "settings-custom_template")
|
||||
(~settings/section :title "Advanced" :content
|
||||
(div (~settings/field-label :text "Custom template" :field-for "settings-custom_template")
|
||||
(input :type "text" :name "custom_template" :id "settings-custom_template"
|
||||
:value (or custom-template "") :placeholder tmpl-placeholder :class input-cls))))
|
||||
(div :class "flex items-center gap-[16px] mt-[24px] pt-[16px] border-t border-stone-200"
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
:auth :admin
|
||||
:layout :blog
|
||||
:data (editor-data)
|
||||
:content (~blog-editor-content
|
||||
:content (~editor/content
|
||||
:csrf csrf :title-placeholder title-placeholder
|
||||
:create-label create-label :css-href css-href
|
||||
:js-src js-src :sx-editor-js-src sx-editor-js-src
|
||||
@@ -20,7 +20,7 @@
|
||||
:auth :admin
|
||||
:layout :blog
|
||||
:data (editor-page-data)
|
||||
:content (~blog-editor-content
|
||||
:content (~editor/content
|
||||
:csrf csrf :title-placeholder title-placeholder
|
||||
:create-label create-label :css-href css-href
|
||||
:js-src js-src :sx-editor-js-src sx-editor-js-src
|
||||
@@ -33,21 +33,21 @@
|
||||
:auth :admin
|
||||
:layout (:post-admin :selected "admin")
|
||||
:data (post-admin-data slug)
|
||||
:content (~blog-admin-placeholder))
|
||||
:content (~admin/placeholder))
|
||||
|
||||
(defpage post-data
|
||||
:path "/<slug>/admin/data/"
|
||||
:auth :admin
|
||||
:layout (:post-admin :selected "data")
|
||||
:data (post-data-data slug)
|
||||
:content (~blog-data-table-content :tablename tablename :model-data model-data))
|
||||
:content (~admin/data-table-content :tablename tablename :model-data model-data))
|
||||
|
||||
(defpage post-preview
|
||||
:path "/<slug>/admin/preview/"
|
||||
:auth :admin
|
||||
:layout (:post-admin :selected "preview")
|
||||
:data (post-preview-data slug)
|
||||
:content (~blog-preview-content
|
||||
:content (~admin/preview-content
|
||||
:sx-pretty sx-pretty :json-pretty json-pretty
|
||||
:sx-rendered sx-rendered :lex-rendered lex-rendered))
|
||||
|
||||
@@ -56,8 +56,8 @@
|
||||
:auth :admin
|
||||
:layout (:post-admin :selected "entries")
|
||||
:data (post-entries-data slug)
|
||||
:content (~blog-entries-browser-content
|
||||
:entries-panel (~blog-associated-entries-from-data :entries entries :csrf csrf)
|
||||
:content (~settings/entries-browser-content
|
||||
:entries-panel (~settings/associated-entries-from-data :entries entries :csrf csrf)
|
||||
:calendars calendars))
|
||||
|
||||
(defpage post-settings
|
||||
@@ -65,7 +65,7 @@
|
||||
:auth :post_author
|
||||
:layout (:post-admin :selected "settings")
|
||||
:data (post-settings-data slug)
|
||||
:content (~blog-settings-form-content
|
||||
:content (~settings/form-content
|
||||
:csrf csrf :updated-at updated-at :is-page is-page
|
||||
:save-success save-success :slug settings-slug
|
||||
:published-at published-at :featured featured
|
||||
@@ -82,7 +82,7 @@
|
||||
:auth :post_author
|
||||
:layout (:post-admin :selected "edit")
|
||||
:data (post-edit-data slug)
|
||||
:content (~blog-edit-content
|
||||
:content (~editor/edit-content
|
||||
:csrf csrf :updated-at updated-at
|
||||
:title-val title-val :excerpt-val excerpt-val
|
||||
:feature-image feature-image :feature-image-caption feature-image-caption
|
||||
@@ -111,7 +111,7 @@
|
||||
:auth :admin
|
||||
:layout :blog-cache
|
||||
:data (service "blog-page" "cache-data")
|
||||
:content (~blog-cache-panel :clear-url clear-url :csrf csrf))
|
||||
:content (~admin/cache-panel :clear-url clear-url :csrf csrf))
|
||||
|
||||
; --- Snippets ---
|
||||
|
||||
@@ -120,7 +120,7 @@
|
||||
:auth :login
|
||||
:layout :blog-snippets
|
||||
:data (service "blog-page" "snippets-data")
|
||||
:content (~blog-snippets-content
|
||||
:content (~admin/snippets-content
|
||||
:snippets snippets :is-admin is-admin :csrf csrf))
|
||||
|
||||
; --- Menu Items ---
|
||||
@@ -130,7 +130,7 @@
|
||||
:auth :admin
|
||||
:layout :blog-menu-items
|
||||
:data (service "blog-page" "menu-items-data")
|
||||
:content (~blog-menu-items-content
|
||||
:content (~admin/menu-items-content
|
||||
:menu-items menu-items :new-url new-url :csrf csrf))
|
||||
|
||||
; --- Tag Groups ---
|
||||
@@ -140,7 +140,7 @@
|
||||
:auth :admin
|
||||
:layout :blog-tag-groups
|
||||
:data (service "blog-page" "tag-groups-data")
|
||||
:content (~blog-tag-groups-content
|
||||
:content (~admin/tag-groups-content
|
||||
:groups groups :unassigned-tags unassigned-tags
|
||||
:create-url create-url :csrf csrf))
|
||||
|
||||
@@ -149,6 +149,6 @@
|
||||
:auth :admin
|
||||
:layout :blog-tag-group-edit
|
||||
:data (service "blog-page" "tag-group-edit-data" :id id)
|
||||
:content (~blog-tag-group-edit-content
|
||||
:content (~admin/tag-group-edit-content
|
||||
:group group :all-tags all-tags
|
||||
:save-url save-url :delete-url delete-url :csrf csrf))
|
||||
|
||||
@@ -167,7 +167,7 @@ class TestCards:
|
||||
result = lexical_to_sx(_doc({
|
||||
"type": "image", "src": "photo.jpg", "alt": "test"
|
||||
}))
|
||||
assert '(~kg-image :src "photo.jpg" :alt "test")' == result
|
||||
assert '(~kg_cards/kg-image :src "photo.jpg" :alt "test")' == result
|
||||
|
||||
def test_image_wide_with_caption(self):
|
||||
result = lexical_to_sx(_doc({
|
||||
@@ -189,7 +189,7 @@ class TestCards:
|
||||
"type": "bookmark", "url": "https://example.com",
|
||||
"metadata": {"title": "Example", "description": "A site"}
|
||||
}))
|
||||
assert "(~kg-bookmark " in result
|
||||
assert "(~kg_cards/kg-bookmark " in result
|
||||
assert ':url "https://example.com"' in result
|
||||
assert ':title "Example"' in result
|
||||
|
||||
@@ -199,7 +199,7 @@ class TestCards:
|
||||
"calloutEmoji": "💡",
|
||||
"children": [_text("Note")]
|
||||
}))
|
||||
assert "(~kg-callout " in result
|
||||
assert "(~kg_cards/kg-callout " in result
|
||||
assert ':color "blue"' in result
|
||||
|
||||
def test_button(self):
|
||||
@@ -207,7 +207,7 @@ class TestCards:
|
||||
"type": "button", "buttonText": "Click",
|
||||
"buttonUrl": "https://example.com"
|
||||
}))
|
||||
assert "(~kg-button " in result
|
||||
assert "(~kg_cards/kg-button " in result
|
||||
assert ':text "Click"' in result
|
||||
|
||||
def test_toggle(self):
|
||||
@@ -215,28 +215,28 @@ class TestCards:
|
||||
"type": "toggle", "heading": "FAQ",
|
||||
"children": [_text("Answer")]
|
||||
}))
|
||||
assert "(~kg-toggle " in result
|
||||
assert "(~kg_cards/kg-toggle " in result
|
||||
assert ':heading "FAQ"' in result
|
||||
|
||||
def test_html(self):
|
||||
result = lexical_to_sx(_doc({
|
||||
"type": "html", "html": "<div>custom</div>"
|
||||
}))
|
||||
assert result == '(~kg-html (div "custom"))'
|
||||
assert result == '(~kg_cards/kg-html (div "custom"))'
|
||||
|
||||
def test_embed(self):
|
||||
result = lexical_to_sx(_doc({
|
||||
"type": "embed", "html": "<iframe></iframe>",
|
||||
"caption": "Video"
|
||||
}))
|
||||
assert "(~kg-embed " in result
|
||||
assert "(~kg_cards/kg-embed " in result
|
||||
assert ':caption "Video"' in result
|
||||
|
||||
def test_markdown(self):
|
||||
result = lexical_to_sx(_doc({
|
||||
"type": "markdown", "markdown": "**bold** text"
|
||||
}))
|
||||
assert result.startswith("(~kg-md ")
|
||||
assert result.startswith("(~kg_cards/kg-md ")
|
||||
assert "(p " in result
|
||||
assert "(strong " in result
|
||||
|
||||
@@ -244,14 +244,14 @@ class TestCards:
|
||||
result = lexical_to_sx(_doc({
|
||||
"type": "video", "src": "v.mp4", "cardWidth": "wide"
|
||||
}))
|
||||
assert "(~kg-video " in result
|
||||
assert "(~kg_cards/kg-video " in result
|
||||
assert ':width "wide"' in result
|
||||
|
||||
def test_audio(self):
|
||||
result = lexical_to_sx(_doc({
|
||||
"type": "audio", "src": "s.mp3", "title": "Song", "duration": 195
|
||||
}))
|
||||
assert "(~kg-audio " in result
|
||||
assert "(~kg_cards/kg-audio " in result
|
||||
assert ':duration "3:15"' in result
|
||||
|
||||
def test_file(self):
|
||||
@@ -259,13 +259,13 @@ class TestCards:
|
||||
"type": "file", "src": "f.pdf", "fileName": "doc.pdf",
|
||||
"fileSize": 2100000
|
||||
}))
|
||||
assert "(~kg-file " in result
|
||||
assert "(~kg_cards/kg-file " in result
|
||||
assert ':filename "doc.pdf"' in result
|
||||
assert "MB" in result
|
||||
|
||||
def test_paywall(self):
|
||||
result = lexical_to_sx(_doc({"type": "paywall"}))
|
||||
assert result == "(~kg-paywall)"
|
||||
assert result == "(~kg_cards/kg-paywall)"
|
||||
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
;; Cart calendar entry components
|
||||
|
||||
(defcomp ~cart-cal-entry (&key name date-str cost)
|
||||
(defcomp ~calendar/cal-entry (&key (name :as string) (date-str :as string) (cost :as string))
|
||||
(li :class "flex items-start justify-between text-sm"
|
||||
(div (div :class "font-medium" name)
|
||||
(div :class "text-xs text-stone-500" date-str))
|
||||
(div :class "ml-4 font-medium" cost)))
|
||||
|
||||
(defcomp ~cart-cal-section (&key items)
|
||||
(defcomp ~calendar/cal-section (&key items)
|
||||
(div :class "mt-6 border-t border-stone-200 pt-4"
|
||||
(h2 :class "text-base font-semibold mb-2" "Calendar bookings")
|
||||
(ul :class "space-y-2" items)))
|
||||
|
||||
@@ -4,6 +4,6 @@
|
||||
;; Renders the "orders" link for the account dashboard nav.
|
||||
|
||||
(defhandler account-nav-item (&key)
|
||||
(~account-nav-item
|
||||
(~shared:fragments/account-nav-item
|
||||
:href (app-url "cart" "/orders/")
|
||||
:label "orders"))
|
||||
|
||||
@@ -10,7 +10,7 @@
|
||||
(count (+ (or (get summary "count") 0)
|
||||
(or (get summary "calendar_count") 0)
|
||||
(or (get summary "ticket_count") 0))))
|
||||
(~cart-mini
|
||||
(~shared:fragments/cart-mini
|
||||
:cart-count count
|
||||
:blog-url (app-url "blog" "")
|
||||
:cart-url (app-url "cart" "")
|
||||
|
||||
@@ -1,14 +1,14 @@
|
||||
;; Cart header components
|
||||
|
||||
(defcomp ~cart-page-label-img (&key src)
|
||||
(defcomp ~header/page-label-img (&key src)
|
||||
(img :src src :class "h-8 w-8 rounded-full object-cover border border-stone-300 flex-shrink-0"))
|
||||
|
||||
(defcomp ~cart-page-label (&key feature-image title)
|
||||
(defcomp ~header/page-label (&key feature-image title)
|
||||
(<> (when feature-image
|
||||
(~cart-page-label-img :src feature-image))
|
||||
(~header/page-label-img :src feature-image))
|
||||
(span title)))
|
||||
|
||||
(defcomp ~cart-all-carts-link (&key href)
|
||||
(defcomp ~header/all-carts-link (&key href)
|
||||
(a :href href :class "inline-flex items-center gap-1.5 px-3 py-1.5 text-sm rounded-full border border-stone-300 bg-white hover:bg-stone-50 transition"
|
||||
(i :class "fa fa-arrow-left text-xs" :aria-hidden "true") "All carts"))
|
||||
|
||||
|
||||
@@ -1,29 +1,29 @@
|
||||
;; Cart item components
|
||||
|
||||
(defcomp ~cart-item-img (&key src alt)
|
||||
(defcomp ~items/img (&key (src :as string) (alt :as string))
|
||||
(img :src src :alt alt :class "w-24 h-24 sm:w-32 sm:h-28 object-cover rounded-xl border border-stone-100" :loading "lazy"))
|
||||
|
||||
(defcomp ~cart-item-price (&key text)
|
||||
(defcomp ~items/price (&key (text :as string))
|
||||
(p :class "text-sm sm:text-base font-semibold text-stone-900" text))
|
||||
|
||||
(defcomp ~cart-item-price-was (&key text)
|
||||
(defcomp ~items/price-was (&key (text :as string))
|
||||
(p :class "text-xs text-stone-400 line-through" text))
|
||||
|
||||
(defcomp ~cart-item-no-price ()
|
||||
(defcomp ~items/no-price ()
|
||||
(p :class "text-xs text-stone-500" "No price"))
|
||||
|
||||
(defcomp ~cart-item-deleted ()
|
||||
(defcomp ~items/deleted ()
|
||||
(p :class "mt-2 inline-flex items-center gap-1 text-[0.65rem] sm:text-xs font-medium text-amber-700 bg-amber-50 border border-amber-200 rounded-full px-2 py-0.5"
|
||||
(i :class "fa-solid fa-triangle-exclamation text-[0.6rem]" :aria-hidden "true")
|
||||
" This item is no longer available or price has changed"))
|
||||
|
||||
(defcomp ~cart-item-brand (&key brand)
|
||||
(defcomp ~items/brand (&key (brand :as string))
|
||||
(p :class "mt-0.5 text-[0.7rem] sm:text-xs text-stone-500" brand))
|
||||
|
||||
(defcomp ~cart-item-line-total (&key text)
|
||||
(defcomp ~items/line-total (&key (text :as string))
|
||||
(p :class "text-sm sm:text-base font-semibold text-stone-900" text))
|
||||
|
||||
(defcomp ~cart-item (&key id img prod-url title brand deleted price qty-url csrf minus qty plus line-total)
|
||||
(defcomp ~items/index (&key (id :as string) img (prod-url :as string) (title :as string) brand deleted price (qty-url :as string) (csrf :as string) (minus :as string) (qty :as string) (plus :as string) line-total)
|
||||
(article :id id :class "flex flex-col sm:flex-row gap-3 sm:gap-4 rounded-2xl bg-white shadow-sm border border-stone-200 p-3 sm:p-4 md:p-5"
|
||||
(div :class "w-full sm:w-32 shrink-0 flex justify-center sm:block" (when img img))
|
||||
(div :class "flex-1 min-w-0"
|
||||
@@ -47,14 +47,14 @@
|
||||
(button :type "submit" :class "inline-flex items-center justify-center w-8 h-8 text-sm font-medium rounded-full border border-emerald-600 text-emerald-700 hover:bg-emerald-50 text-xl" "+")))
|
||||
(div :class "flex items-center justify-between sm:justify-end gap-3" (when line-total line-total))))))
|
||||
|
||||
(defcomp ~cart-page-panel (&key items cal tickets summary)
|
||||
(defcomp ~items/page-panel (&key items cal tickets summary)
|
||||
(div :class "max-w-full px-3 py-3 space-y-3"
|
||||
(div :id "cart"
|
||||
(div (section :class "space-y-3 sm:space-y-4" items cal tickets)
|
||||
summary))))
|
||||
|
||||
;; Assembled cart item from serialized data — replaces Python _cart_item_sx
|
||||
(defcomp ~cart-item-from-data (&key item)
|
||||
(defcomp ~items/from-data (&key (item :as dict))
|
||||
(let* ((slug (or (get item "slug") ""))
|
||||
(title (or (get item "title") ""))
|
||||
(image (get item "image"))
|
||||
@@ -71,48 +71,48 @@
|
||||
(qty-url (or (get item "qty_url") ""))
|
||||
(csrf (csrf-token))
|
||||
(line-total (when unit-price (* unit-price quantity))))
|
||||
(~cart-item
|
||||
(~items/index
|
||||
:id (str "cart-item-" slug)
|
||||
:img (if image
|
||||
(~cart-item-img :src image :alt title)
|
||||
(~img-or-placeholder :src nil
|
||||
(~items/img :src image :alt title)
|
||||
(~shared:misc/img-or-placeholder :src nil
|
||||
:size-cls "w-24 h-24 sm:w-32 sm:h-28 rounded-xl border border-dashed border-stone-300"
|
||||
:placeholder-text "No image"))
|
||||
:prod-url prod-url
|
||||
:title title
|
||||
:brand (when brand (~cart-item-brand :brand brand))
|
||||
:deleted (when is-deleted (~cart-item-deleted))
|
||||
:brand (when brand (~items/brand :brand brand))
|
||||
:deleted (when is-deleted (~items/deleted))
|
||||
:price (if unit-price
|
||||
(<>
|
||||
(~cart-item-price :text (str symbol (format-decimal unit-price 2)))
|
||||
(~items/price :text (str symbol (format-decimal unit-price 2)))
|
||||
(when (and special-price (!= special-price regular-price))
|
||||
(~cart-item-price-was :text (str symbol (format-decimal regular-price 2)))))
|
||||
(~cart-item-no-price))
|
||||
(~items/price-was :text (str symbol (format-decimal regular-price 2)))))
|
||||
(~items/no-price))
|
||||
:qty-url qty-url :csrf csrf
|
||||
:minus (str (- quantity 1))
|
||||
:qty (str quantity)
|
||||
:plus (str (+ quantity 1))
|
||||
:line-total (when line-total
|
||||
(~cart-item-line-total :text (str "Line total: " symbol (format-decimal line-total 2)))))))
|
||||
(~items/line-total :text (str "Line total: " symbol (format-decimal line-total 2)))))))
|
||||
|
||||
;; Assembled calendar entries section — replaces Python _calendar_entries_sx
|
||||
(defcomp ~cart-cal-section-from-data (&key entries)
|
||||
(defcomp ~items/cal-section-from-data (&key (entries :as list))
|
||||
(when (not (empty? entries))
|
||||
(~cart-cal-section
|
||||
(~calendar/cal-section
|
||||
:items (map (lambda (e)
|
||||
(let* ((name (or (get e "name") ""))
|
||||
(date-str (or (get e "date_str") "")))
|
||||
(~cart-cal-entry
|
||||
(~calendar/cal-entry
|
||||
:name name :date-str date-str
|
||||
:cost (str "\u00a3" (format-decimal (or (get e "cost") 0) 2)))))
|
||||
entries))))
|
||||
|
||||
;; Assembled ticket groups section — replaces Python _ticket_groups_sx
|
||||
(defcomp ~cart-tickets-section-from-data (&key ticket-groups)
|
||||
(defcomp ~items/tickets-section-from-data (&key (ticket-groups :as list))
|
||||
(when (not (empty? ticket-groups))
|
||||
(let* ((csrf (csrf-token))
|
||||
(qty-url (url-for "cart_global.update_ticket_quantity")))
|
||||
(~cart-tickets-section
|
||||
(~tickets/section
|
||||
:items (map (lambda (tg)
|
||||
(let* ((name (or (get tg "entry_name") ""))
|
||||
(tt-name (get tg "ticket_type_name"))
|
||||
@@ -122,14 +122,14 @@
|
||||
(entry-id (str (or (get tg "entry_id") "")))
|
||||
(tt-id (get tg "ticket_type_id"))
|
||||
(date-str (or (get tg "date_str") "")))
|
||||
(~cart-ticket-article
|
||||
(~tickets/article
|
||||
:name name
|
||||
:type-name (when tt-name (~cart-ticket-type-name :name tt-name))
|
||||
:type-name (when tt-name (~tickets/type-name :name tt-name))
|
||||
:date-str date-str
|
||||
:price (str "\u00a3" (format-decimal price 2))
|
||||
:qty-url qty-url :csrf csrf
|
||||
:entry-id entry-id
|
||||
:type-hidden (when tt-id (~cart-ticket-type-hidden :value (str tt-id)))
|
||||
:type-hidden (when tt-id (~tickets/type-hidden :value (str tt-id)))
|
||||
:minus (str (max (- quantity 1) 0))
|
||||
:qty (str quantity)
|
||||
:plus (str (+ quantity 1))
|
||||
@@ -137,29 +137,29 @@
|
||||
ticket-groups)))))
|
||||
|
||||
;; Assembled cart summary — replaces Python _cart_summary_sx
|
||||
(defcomp ~cart-summary-from-data (&key item-count grand-total symbol is-logged-in checkout-action login-href user-email)
|
||||
(~cart-summary-panel
|
||||
(defcomp ~items/summary-from-data (&key (item-count :as number) (grand-total :as number) (symbol :as string) (is-logged-in :as boolean) (checkout-action :as string) (login-href :as string) (user-email :as string?))
|
||||
(~summary/panel
|
||||
:item-count (str item-count)
|
||||
:subtotal (str symbol (format-decimal grand-total 2))
|
||||
:checkout (if is-logged-in
|
||||
(~cart-checkout-form
|
||||
(~summary/checkout-form
|
||||
:action checkout-action :csrf (csrf-token)
|
||||
:label (str " Checkout as " user-email))
|
||||
(~cart-checkout-signin :href login-href))))
|
||||
(~summary/checkout-signin :href login-href))))
|
||||
|
||||
;; Assembled page cart content — replaces Python _page_cart_main_panel_sx
|
||||
(defcomp ~cart-page-cart-content (&key cart-items cal-entries ticket-groups summary)
|
||||
(defcomp ~items/page-cart-content (&key (cart-items :as list?) (cal-entries :as list?) (ticket-groups :as list?) summary)
|
||||
(if (and (empty? (or cart-items (list)))
|
||||
(empty? (or cal-entries (list)))
|
||||
(empty? (or ticket-groups (list))))
|
||||
(div :class "max-w-full px-3 py-3 space-y-3"
|
||||
(div :id "cart"
|
||||
(div :class "rounded-2xl border border-dashed border-stone-300 bg-white/80 p-6 sm:p-8 text-center"
|
||||
(~empty-state :icon "fa fa-shopping-cart" :message "Your cart is empty" :cls "text-center"))))
|
||||
(~cart-page-panel
|
||||
:items (map (lambda (item) (~cart-item-from-data :item item)) (or cart-items (list)))
|
||||
(~shared:misc/empty-state :icon "fa fa-shopping-cart" :message "Your cart is empty" :cls "text-center"))))
|
||||
(~items/page-panel
|
||||
:items (map (lambda (item) (~items/from-data :item item)) (or cart-items (list)))
|
||||
:cal (when (not (empty? (or cal-entries (list))))
|
||||
(~cart-cal-section-from-data :entries cal-entries))
|
||||
(~items/cal-section-from-data :entries cal-entries))
|
||||
:tickets (when (not (empty? (or ticket-groups (list))))
|
||||
(~cart-tickets-section-from-data :ticket-groups ticket-groups))
|
||||
(~items/tickets-section-from-data :ticket-groups ticket-groups))
|
||||
:summary summary)))
|
||||
|
||||
@@ -10,17 +10,17 @@
|
||||
(quasiquote
|
||||
(let ((__cpctx (cart-page-ctx)))
|
||||
(<>
|
||||
(~menu-row-sx :id "cart-row" :level 1 :colour "sky"
|
||||
(~shared:layout/menu-row-sx :id "cart-row" :level 1 :colour "sky"
|
||||
:link-href (get __cpctx "cart-url")
|
||||
:link-label "cart" :icon "fa fa-shopping-cart"
|
||||
:child-id "cart-header-child")
|
||||
(~header-child-sx :id "cart-header-child"
|
||||
:inner (~menu-row-sx :id "page-cart-row" :level 2 :colour "sky"
|
||||
(~shared:layout/header-child-sx :id "cart-header-child"
|
||||
:inner (~shared:layout/menu-row-sx :id "page-cart-row" :level 2 :colour "sky"
|
||||
:link-href (get __cpctx "page-cart-url")
|
||||
:link-label-content (~cart-page-label
|
||||
:link-label-content (~header/page-label
|
||||
:feature-image (get __cpctx "feature-image")
|
||||
:title (get __cpctx "title"))
|
||||
:nav (~cart-all-carts-link :href (get __cpctx "cart-url"))
|
||||
:nav (~header/all-carts-link :href (get __cpctx "cart-url"))
|
||||
:oob (unquote oob)))))))
|
||||
|
||||
(defmacro ~cart-page-header-oob ()
|
||||
@@ -28,14 +28,14 @@
|
||||
(quasiquote
|
||||
(let ((__cpctx (cart-page-ctx)))
|
||||
(<>
|
||||
(~menu-row-sx :id "page-cart-row" :level 2 :colour "sky"
|
||||
(~shared:layout/menu-row-sx :id "page-cart-row" :level 2 :colour "sky"
|
||||
:link-href (get __cpctx "page-cart-url")
|
||||
:link-label-content (~cart-page-label
|
||||
:link-label-content (~header/page-label
|
||||
:feature-image (get __cpctx "feature-image")
|
||||
:title (get __cpctx "title"))
|
||||
:nav (~cart-all-carts-link :href (get __cpctx "cart-url"))
|
||||
:nav (~header/all-carts-link :href (get __cpctx "cart-url"))
|
||||
:oob true)
|
||||
(~menu-row-sx :id "cart-row" :level 1 :colour "sky"
|
||||
(~shared:layout/menu-row-sx :id "cart-row" :level 1 :colour "sky"
|
||||
:link-href (get __cpctx "cart-url")
|
||||
:link-label "cart" :icon "fa fa-shopping-cart"
|
||||
:child-id "cart-header-child"
|
||||
@@ -45,12 +45,12 @@
|
||||
;; cart-page layout: root + cart row + page-cart row
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~cart-page-layout-full ()
|
||||
(defcomp ~layouts/page-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (~cart-page-header-auto))))
|
||||
|
||||
(defcomp ~cart-page-layout-oob ()
|
||||
(defcomp ~layouts/page-layout-oob ()
|
||||
(<> (~cart-page-header-oob)
|
||||
(~root-header-auto true)))
|
||||
|
||||
@@ -59,14 +59,14 @@
|
||||
;; Uses (post-header-ctx) — requires :data handler to populate g._defpage_ctx
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~cart-admin-layout-full (&key selected)
|
||||
(defcomp ~layouts/admin-layout-full (&key selected)
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (~post-header-auto nil))))
|
||||
|
||||
(defcomp ~cart-admin-layout-oob (&key selected)
|
||||
(defcomp ~layouts/admin-layout-oob (&key selected)
|
||||
(<> (~post-header-auto true)
|
||||
(~oob-header-sx :parent-id "post-header-child"
|
||||
(~shared:layout/oob-header-sx :parent-id "post-header-child"
|
||||
:row (~post-admin-header-auto nil selected))
|
||||
(~root-header-auto true)))
|
||||
|
||||
@@ -74,63 +74,63 @@
|
||||
;; orders-within-cart: root + auth-simple + orders
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~cart-orders-layout-full (&key list-url)
|
||||
(defcomp ~layouts/orders-layout-full (&key list-url)
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (<> (~auth-header-row-simple-auto)
|
||||
(~header-child-sx :id "auth-header-child"
|
||||
:inner (~orders-header-row :list-url list-url))))))
|
||||
(~shared:layout/header-child-sx :id "auth-header-child"
|
||||
:inner (~shared:auth/orders-header-row :list-url list-url))))))
|
||||
|
||||
(defcomp ~cart-orders-layout-oob (&key list-url)
|
||||
(defcomp ~layouts/orders-layout-oob (&key list-url)
|
||||
(<> (~auth-header-row-simple-auto true)
|
||||
(~oob-header-sx
|
||||
(~shared:layout/oob-header-sx
|
||||
:parent-id "auth-header-child"
|
||||
:row (~orders-header-row :list-url list-url))
|
||||
:row (~shared:auth/orders-header-row :list-url list-url))
|
||||
(~root-header-auto true)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; order-detail-within-cart: root + auth-simple + orders + order
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~cart-order-detail-layout-full (&key list-url detail-url order-label)
|
||||
(defcomp ~layouts/order-detail-layout-full (&key list-url detail-url order-label)
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (<> (~auth-header-row-simple-auto)
|
||||
(~header-child-sx :id "auth-header-child"
|
||||
:inner (<> (~orders-header-row :list-url list-url)
|
||||
(~header-child-sx :id "orders-header-child"
|
||||
:inner (~menu-row-sx :id "order-row" :level 3 :colour "sky"
|
||||
(~shared:layout/header-child-sx :id "auth-header-child"
|
||||
:inner (<> (~shared:auth/orders-header-row :list-url list-url)
|
||||
(~shared:layout/header-child-sx :id "orders-header-child"
|
||||
:inner (~shared:layout/menu-row-sx :id "order-row" :level 3 :colour "sky"
|
||||
:link-href detail-url
|
||||
:link-label order-label
|
||||
:icon "fa fa-gbp"))))))))
|
||||
|
||||
(defcomp ~cart-order-detail-layout-oob (&key detail-url order-label)
|
||||
(<> (~oob-header-sx
|
||||
(defcomp ~layouts/order-detail-layout-oob (&key detail-url order-label)
|
||||
(<> (~shared:layout/oob-header-sx
|
||||
:parent-id "orders-header-child"
|
||||
:row (~menu-row-sx :id "order-row" :level 3 :colour "sky"
|
||||
:row (~shared:layout/menu-row-sx :id "order-row" :level 3 :colour "sky"
|
||||
:link-href detail-url :link-label order-label
|
||||
:icon "fa fa-gbp" :oob true))
|
||||
(~root-header-auto true)))
|
||||
|
||||
;; --- orders rows wrapper (for infinite scroll) ---
|
||||
|
||||
(defcomp ~cart-orders-rows (&key rows next-scroll)
|
||||
(defcomp ~layouts/orders-rows (&key rows next-scroll)
|
||||
(<> rows next-scroll))
|
||||
|
||||
;; Composition defcomp — replaces Python loop in render_orders_rows
|
||||
(defcomp ~cart-orders-rows-content (&key orders detail-url-prefix page total-pages next-url)
|
||||
(~cart-orders-rows
|
||||
(defcomp ~layouts/orders-rows-content (&key orders detail-url-prefix page total-pages next-url)
|
||||
(~layouts/orders-rows
|
||||
:rows (map (lambda (od)
|
||||
(~order-row-pair :order od :detail-url-prefix detail-url-prefix))
|
||||
(~shared:orders/row-pair :order od :detail-url-prefix detail-url-prefix))
|
||||
(or orders (list)))
|
||||
:next-scroll (if (< page total-pages)
|
||||
(~infinite-scroll :url next-url :page page
|
||||
(~shared:controls/infinite-scroll :url next-url :page page
|
||||
:total-pages total-pages :id-prefix "orders" :colspan 5)
|
||||
(~order-end-row))))
|
||||
(~shared:orders/end-row))))
|
||||
|
||||
;; Composition defcomp — replaces conditional composition in render_checkout_error_page
|
||||
(defcomp ~cart-checkout-error-from-data (&key msg order-id back-url)
|
||||
(~checkout-error-content
|
||||
(defcomp ~layouts/checkout-error-from-data (&key msg order-id back-url)
|
||||
(~shared:orders/checkout-error-content
|
||||
:msg msg
|
||||
:order (when order-id (~checkout-error-order-id :oid (str "#" order-id)))
|
||||
:order (when order-id (~shared:orders/checkout-error-order-id :oid (str "#" order-id)))
|
||||
:back-url back-url))
|
||||
|
||||
@@ -1,20 +1,20 @@
|
||||
;; Cart overview components
|
||||
|
||||
(defcomp ~cart-badge (&key icon text)
|
||||
(defcomp ~overview/badge (&key (icon :as string) (text :as string))
|
||||
(span :class "inline-flex items-center gap-1 px-2 py-0.5 rounded-full bg-stone-100"
|
||||
(i :class icon :aria-hidden "true") text))
|
||||
|
||||
(defcomp ~cart-badges-wrap (&key badges)
|
||||
(defcomp ~overview/badges-wrap (&key badges)
|
||||
(div :class "mt-1 flex flex-wrap gap-2 text-xs text-stone-600"
|
||||
badges))
|
||||
|
||||
(defcomp ~cart-group-card-img (&key src alt)
|
||||
(defcomp ~overview/group-card-img (&key (src :as string) (alt :as string))
|
||||
(img :src src :alt alt :class "h-16 w-16 rounded-xl object-cover border border-stone-200 flex-shrink-0"))
|
||||
|
||||
(defcomp ~cart-mp-subtitle (&key title)
|
||||
(defcomp ~overview/mp-subtitle (&key (title :as string))
|
||||
(p :class "text-xs text-stone-500 truncate" title))
|
||||
|
||||
(defcomp ~cart-group-card (&key href img display-title subtitle badges total)
|
||||
(defcomp ~overview/group-card (&key (href :as string) img (display-title :as string) subtitle badges (total :as string))
|
||||
(a :href href :class "block rounded-2xl border border-stone-200 bg-white shadow-sm hover:shadow-md hover:border-stone-300 transition p-4 sm:p-5"
|
||||
(div :class "flex items-start gap-4"
|
||||
img
|
||||
@@ -25,7 +25,7 @@
|
||||
(div :class "text-lg font-bold text-stone-900" total)
|
||||
(div :class "mt-1 text-xs text-emerald-700 font-medium" "View cart \u2192")))))
|
||||
|
||||
(defcomp ~cart-orphan-card (&key badges total)
|
||||
(defcomp ~overview/orphan-card (&key badges (total :as string))
|
||||
(div :class "rounded-2xl border border-dashed border-amber-300 bg-amber-50/60 p-4 sm:p-5"
|
||||
(div :class "flex items-start gap-4"
|
||||
(div :class "h-16 w-16 rounded-xl bg-amber-100 flex items-center justify-center flex-shrink-0"
|
||||
@@ -36,17 +36,17 @@
|
||||
(div :class "text-right flex-shrink-0"
|
||||
(div :class "text-lg font-bold text-stone-900" total)))))
|
||||
|
||||
(defcomp ~cart-overview-panel (&key cards)
|
||||
(defcomp ~overview/panel (&key cards)
|
||||
(div :class "max-w-full px-3 py-3 space-y-3"
|
||||
(div :class "space-y-4" cards)))
|
||||
|
||||
(defcomp ~cart-empty ()
|
||||
(defcomp ~overview/empty ()
|
||||
(div :class "max-w-full px-3 py-3 space-y-3"
|
||||
(div :class "rounded-2xl border border-dashed border-stone-300 bg-white/80 p-6 sm:p-8 text-center"
|
||||
(~empty-state :icon "fa fa-shopping-cart" :message "Your cart is empty" :cls "text-center"))))
|
||||
(~shared:misc/empty-state :icon "fa fa-shopping-cart" :message "Your cart is empty" :cls "text-center"))))
|
||||
|
||||
;; Assembled page group card — replaces Python _page_group_card_sx
|
||||
(defcomp ~cart-page-group-card-from-data (&key grp cart-url-base)
|
||||
(defcomp ~overview/page-group-card-from-data (&key (grp :as dict) (cart-url-base :as string))
|
||||
(let* ((post (get grp "post"))
|
||||
(product-count (or (get grp "product_count") 0))
|
||||
(calendar-count (or (get grp "calendar_count") 0))
|
||||
@@ -55,13 +55,13 @@
|
||||
(market-place (get grp "market_place"))
|
||||
(badges (<>
|
||||
(when (> product-count 0)
|
||||
(~cart-badge :icon "fa fa-box-open"
|
||||
(~overview/badge :icon "fa fa-box-open"
|
||||
:text (str product-count " item" (pluralize product-count))))
|
||||
(when (> calendar-count 0)
|
||||
(~cart-badge :icon "fa fa-calendar"
|
||||
(~overview/badge :icon "fa fa-calendar"
|
||||
:text (str calendar-count " booking" (pluralize calendar-count))))
|
||||
(when (> ticket-count 0)
|
||||
(~cart-badge :icon "fa fa-ticket"
|
||||
(~overview/badge :icon "fa fa-ticket"
|
||||
:text (str ticket-count " ticket" (pluralize ticket-count)))))))
|
||||
(if post
|
||||
(let* ((slug (or (get post "slug") ""))
|
||||
@@ -69,26 +69,26 @@
|
||||
(feature-image (get post "feature_image"))
|
||||
(mp-name (if market-place (or (get market-place "name") "") ""))
|
||||
(display-title (if (!= mp-name "") mp-name title)))
|
||||
(~cart-group-card
|
||||
(~overview/group-card
|
||||
:href (str cart-url-base "/" slug "/")
|
||||
:img (if feature-image
|
||||
(~cart-group-card-img :src feature-image :alt title)
|
||||
(~img-or-placeholder :src nil :size-cls "h-16 w-16 rounded-xl"
|
||||
(~overview/group-card-img :src feature-image :alt title)
|
||||
(~shared:misc/img-or-placeholder :src nil :size-cls "h-16 w-16 rounded-xl"
|
||||
:placeholder-icon "fa fa-store text-xl"))
|
||||
:display-title display-title
|
||||
:subtitle (when (!= mp-name "")
|
||||
(~cart-mp-subtitle :title title))
|
||||
:badges (~cart-badges-wrap :badges badges)
|
||||
(~overview/mp-subtitle :title title))
|
||||
:badges (~overview/badges-wrap :badges badges)
|
||||
:total (str "\u00a3" (format-decimal total 2))))
|
||||
(~cart-orphan-card
|
||||
:badges (~cart-badges-wrap :badges badges)
|
||||
(~overview/orphan-card
|
||||
:badges (~overview/badges-wrap :badges badges)
|
||||
:total (str "\u00a3" (format-decimal total 2))))))
|
||||
|
||||
;; Assembled cart overview content — replaces Python _overview_main_panel_sx
|
||||
(defcomp ~cart-overview-content (&key page-groups cart-url-base)
|
||||
(defcomp ~overview/content (&key (page-groups :as list) (cart-url-base :as string))
|
||||
(if (empty? page-groups)
|
||||
(~cart-empty)
|
||||
(~cart-overview-panel
|
||||
(~overview/empty)
|
||||
(~overview/panel
|
||||
:cards (map (lambda (grp)
|
||||
(~cart-page-group-card-from-data :grp grp :cart-url-base cart-url-base))
|
||||
(~overview/page-group-card-from-data :grp grp :cart-url-base cart-url-base))
|
||||
page-groups))))
|
||||
|
||||
@@ -1,13 +1,13 @@
|
||||
;; Cart payments components
|
||||
|
||||
(defcomp ~cart-payments-panel (&key update-url csrf merchant-code placeholder input-cls sumup-configured checkout-prefix)
|
||||
(defcomp ~payments/panel (&key update-url csrf merchant-code placeholder input-cls sumup-configured checkout-prefix)
|
||||
(section :class "p-4 max-w-lg mx-auto"
|
||||
(~sumup-settings-form :update-url update-url :csrf csrf :merchant-code merchant-code
|
||||
(~shared:misc/sumup-settings-form :update-url update-url :csrf csrf :merchant-code merchant-code
|
||||
:placeholder placeholder :input-cls input-cls :sumup-configured sumup-configured
|
||||
:checkout-prefix checkout-prefix :sx-select "#payments-panel")))
|
||||
|
||||
;; Assembled cart admin overview content
|
||||
(defcomp ~cart-admin-content ()
|
||||
(defcomp ~payments/admin-content ()
|
||||
(let* ((payments-href (url-for "defpage_cart_payments")))
|
||||
(div :id "main-panel"
|
||||
(div :class "flex items-center justify-between p-3 border-b"
|
||||
@@ -15,13 +15,13 @@
|
||||
(a :href payments-href :class "text-sm underline" "configure")))))
|
||||
|
||||
;; Assembled cart payments content
|
||||
(defcomp ~cart-payments-content (&key page-config)
|
||||
(defcomp ~payments/content (&key page-config)
|
||||
(let* ((sumup-configured (and page-config (get page-config "sumup_api_key")))
|
||||
(merchant-code (or (get page-config "sumup_merchant_code") ""))
|
||||
(checkout-prefix (or (get page-config "sumup_checkout_prefix") ""))
|
||||
(placeholder (if sumup-configured "--------" "sup_sk_..."))
|
||||
(input-cls "w-full px-3 py-1.5 text-sm border border-stone-300 rounded focus:ring-purple-500 focus:border-purple-500"))
|
||||
(~cart-payments-panel
|
||||
(~payments/panel
|
||||
:update-url (url-for "page_admin.update_sumup")
|
||||
:csrf (csrf-token)
|
||||
:merchant-code merchant-code
|
||||
|
||||
@@ -1,17 +1,17 @@
|
||||
;; Cart summary / checkout components
|
||||
|
||||
(defcomp ~cart-checkout-form (&key action csrf label)
|
||||
(defcomp ~summary/checkout-form (&key (action :as string) (csrf :as string) (label :as string))
|
||||
(form :method "post" :action action :class "w-full"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit" :class "w-full inline-flex items-center justify-center px-4 py-2 text-xs sm:text-sm rounded-full border border-emerald-600 bg-emerald-600 text-white hover:bg-emerald-700 transition"
|
||||
(i :class "fa-solid fa-credit-card mr-2" :aria-hidden "true") label)))
|
||||
|
||||
(defcomp ~cart-checkout-signin (&key href)
|
||||
(defcomp ~summary/checkout-signin (&key (href :as string))
|
||||
(div :class "w-full flex"
|
||||
(a :href href :class "w-full cursor-pointer flex flex-row items-center justify-center p-3 gap-2 rounded bg-stone-200 text-black hover:bg-stone-300 transition"
|
||||
(i :class "fa-solid fa-key") (span "sign in or register to checkout"))))
|
||||
|
||||
(defcomp ~cart-summary-panel (&key item-count subtotal checkout)
|
||||
(defcomp ~summary/panel (&key (item-count :as string) (subtotal :as string) checkout)
|
||||
(aside :id "cart-summary" :class "lg:pl-2"
|
||||
(div :class "rounded-2xl bg-white shadow-sm border border-stone-200 p-4 sm:p-5"
|
||||
(h2 :class "text-sm sm:text-base font-semibold text-stone-900 mb-3 sm:mb-4" "Order summary")
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
;; Cart ticket components
|
||||
|
||||
(defcomp ~cart-ticket-type-name (&key name)
|
||||
(defcomp ~tickets/type-name (&key (name :as string))
|
||||
(p :class "mt-0.5 text-[0.7rem] sm:text-xs text-stone-500" name))
|
||||
|
||||
(defcomp ~cart-ticket-type-hidden (&key value)
|
||||
(defcomp ~tickets/type-hidden (&key (value :as string))
|
||||
(input :type "hidden" :name "ticket_type_id" :value value))
|
||||
|
||||
(defcomp ~cart-ticket-article (&key name type-name date-str price qty-url csrf entry-id type-hidden minus qty plus line-total)
|
||||
(defcomp ~tickets/article (&key (name :as string) type-name (date-str :as string) (price :as string) (qty-url :as string) (csrf :as string) (entry-id :as string) type-hidden (minus :as string) (qty :as string) (plus :as string) (line-total :as string))
|
||||
(article :class "flex flex-col sm:flex-row gap-3 sm:gap-4 rounded-2xl bg-white shadow-sm border border-stone-200 p-3 sm:p-4"
|
||||
(div :class "flex-1 min-w-0"
|
||||
(div :class "flex flex-col sm:flex-row sm:items-start justify-between gap-2 sm:gap-3"
|
||||
@@ -35,7 +35,7 @@
|
||||
(div :class "flex items-center justify-between sm:justify-end gap-3"
|
||||
(p :class "text-sm sm:text-base font-semibold text-stone-900" line-total))))))
|
||||
|
||||
(defcomp ~cart-tickets-section (&key items)
|
||||
(defcomp ~tickets/section (&key items)
|
||||
(div :class "mt-6 border-t border-stone-200 pt-4"
|
||||
(h2 :class "text-base font-semibold mb-2"
|
||||
(i :class "fa fa-ticket mr-1" :aria-hidden "true") " Event tickets")
|
||||
|
||||
@@ -6,7 +6,7 @@
|
||||
:auth :public
|
||||
:layout :root
|
||||
:data (service "cart-page" "overview-data")
|
||||
:content (~cart-overview-content
|
||||
:content (~overview/content
|
||||
:page-groups page-groups
|
||||
:cart-url-base cart-url-base))
|
||||
|
||||
@@ -15,11 +15,11 @@
|
||||
:auth :public
|
||||
:layout :cart-page
|
||||
:data (service "cart-page" "page-cart-data")
|
||||
:content (~cart-page-cart-content
|
||||
:content (~items/page-cart-content
|
||||
:cart-items cart-items
|
||||
:cal-entries cal-entries
|
||||
:ticket-groups ticket-groups
|
||||
:summary (~cart-summary-from-data
|
||||
:summary (~items/summary-from-data
|
||||
:item-count (get summary "item_count")
|
||||
:grand-total (get summary "grand_total")
|
||||
:symbol (get summary "symbol")
|
||||
@@ -33,12 +33,12 @@
|
||||
:auth :admin
|
||||
:layout :cart-admin
|
||||
:data (service "cart-page" "admin-data")
|
||||
:content (~cart-admin-content))
|
||||
:content (~payments/admin-content))
|
||||
|
||||
(defpage cart-payments
|
||||
:path "/<page_slug>/admin/payments/"
|
||||
:auth :admin
|
||||
:layout (:cart-admin :selected "payments")
|
||||
:data (service "cart-page" "payments-admin-data")
|
||||
:content (~cart-payments-content
|
||||
:content (~payments/content
|
||||
:page-config page-config))
|
||||
|
||||
@@ -15,7 +15,7 @@ async def render_orders_page(ctx, orders, page, total_pages, search, search_coun
|
||||
order_dicts = [_serialize_order(o) for o in orders]
|
||||
content = sx_call("orders-list-content", orders=order_dicts,
|
||||
page=page, total_pages=total_pages, rows_url=list_url, detail_url_prefix=detail_url_prefix)
|
||||
header_rows = await render_to_sx_with_env("cart-orders-layout-full", {},
|
||||
header_rows = await render_to_sx_with_env("layouts/orders-layout-full", {},
|
||||
list_url=list_url,
|
||||
)
|
||||
filt = sx_call("order-list-header", search_mobile=await search_mobile_sx(ctx))
|
||||
@@ -47,7 +47,7 @@ async def render_orders_oob(ctx, orders, page, total_pages, search, search_count
|
||||
order_dicts = [_serialize_order(o) for o in orders]
|
||||
content = sx_call("orders-list-content", orders=order_dicts,
|
||||
page=page, total_pages=total_pages, rows_url=list_url, detail_url_prefix=detail_url_prefix)
|
||||
oobs = await render_to_sx_with_env("cart-orders-layout-oob", {},
|
||||
oobs = await render_to_sx_with_env("layouts/orders-layout-oob", {},
|
||||
list_url=list_url,
|
||||
)
|
||||
filt = sx_call("order-list-header", search_mobile=await search_mobile_sx(ctx))
|
||||
@@ -68,7 +68,7 @@ async def render_order_page(ctx, order, calendar_entries, url_for_fn):
|
||||
main = sx_call("order-detail-content", order=order_data, calendar_entries=cal_data)
|
||||
filt = sx_call("order-detail-filter-content", order=order_data,
|
||||
list_url=list_url, recheck_url=recheck_url, pay_url=pay_url, csrf=generate_csrf_token())
|
||||
header_rows = await render_to_sx_with_env("cart-order-detail-layout-full", {},
|
||||
header_rows = await render_to_sx_with_env("layouts/order-detail-layout-full", {},
|
||||
list_url=list_url, detail_url=detail_url,
|
||||
order_label=f"Order {order.id}",
|
||||
)
|
||||
@@ -89,7 +89,7 @@ async def render_order_oob(ctx, order, calendar_entries, url_for_fn):
|
||||
main = sx_call("order-detail-content", order=order_data, calendar_entries=cal_data)
|
||||
filt = sx_call("order-detail-filter-content", order=order_data,
|
||||
list_url=list_url, recheck_url=recheck_url, pay_url=pay_url, csrf=generate_csrf_token())
|
||||
oobs = await render_to_sx_with_env("cart-order-detail-layout-oob", {},
|
||||
oobs = await render_to_sx_with_env("layouts/order-detail-layout-oob", {},
|
||||
detail_url=detail_url,
|
||||
order_label=f"Order {order.id}",
|
||||
)
|
||||
@@ -100,7 +100,7 @@ async def render_checkout_error_page(ctx, error=None, order=None):
|
||||
from shared.sx.helpers import sx_call, render_to_sx_with_env, full_page_sx
|
||||
from shared.infrastructure.urls import cart_url
|
||||
err_msg = error or "Unexpected error while creating the hosted checkout session."
|
||||
hdr = await render_to_sx_with_env("layout-root-full", {})
|
||||
hdr = await render_to_sx_with_env("shared:layout/root-full", {})
|
||||
filt = sx_call("checkout-error-header")
|
||||
content = sx_call("cart-checkout-error-from-data",
|
||||
msg=err_msg, order_id=order.id if order else None,
|
||||
|
||||
30
dev-sx.sh
Executable file
30
dev-sx.sh
Executable file
@@ -0,0 +1,30 @@
|
||||
#!/usr/bin/env bash
|
||||
set -euo pipefail
|
||||
|
||||
# Dev mode for sx_docs only (standalone, no DB)
|
||||
# Bind-mounted source + auto-reload on externalnet
|
||||
# Browse to sx.rose-ash.com
|
||||
#
|
||||
# Usage:
|
||||
# ./dev-sx.sh # Start sx_docs dev
|
||||
# ./dev-sx.sh down # Stop
|
||||
# ./dev-sx.sh logs # Tail logs
|
||||
# ./dev-sx.sh --build # Rebuild image then start
|
||||
|
||||
COMPOSE="docker compose -p sx-dev -f docker-compose.dev-sx.yml"
|
||||
|
||||
case "${1:-up}" in
|
||||
down)
|
||||
$COMPOSE down
|
||||
;;
|
||||
logs)
|
||||
$COMPOSE logs -f sx_docs
|
||||
;;
|
||||
*)
|
||||
BUILD_FLAG=""
|
||||
if [[ "${1:-}" == "--build" ]]; then
|
||||
BUILD_FLAG="--build"
|
||||
fi
|
||||
$COMPOSE up $BUILD_FLAG
|
||||
;;
|
||||
esac
|
||||
64
docker-compose.dev-sx.yml
Normal file
64
docker-compose.dev-sx.yml
Normal file
@@ -0,0 +1,64 @@
|
||||
# Standalone dev mode for sx_docs only
|
||||
# Replaces ~/sx-web production stack with bind-mounted source + auto-reload
|
||||
# Accessible at sx.rose-ash.com via Caddy on externalnet
|
||||
|
||||
services:
|
||||
sx_docs:
|
||||
image: registry.rose-ash.com:5000/sx_docs:latest
|
||||
environment:
|
||||
SX_STANDALONE: "true"
|
||||
SECRET_KEY: "${SECRET_KEY:-sx-dev-secret}"
|
||||
REDIS_URL: redis://redis:6379/0
|
||||
WORKERS: "1"
|
||||
ENVIRONMENT: development
|
||||
RELOAD: "true"
|
||||
SX_USE_REF: "1"
|
||||
SX_USE_OCAML: "1"
|
||||
SX_OCAML_BIN: "/app/bin/sx_server"
|
||||
SX_BOUNDARY_STRICT: "1"
|
||||
SX_DEV: "1"
|
||||
volumes:
|
||||
- /root/rose-ash/_config/dev-sh-config.yaml:/app/config/app-config.yaml:ro
|
||||
- ./shared:/app/shared
|
||||
- ./sx/app.py:/app/app.py
|
||||
- ./sx/sxc:/app/sxc
|
||||
- ./sx/bp:/app/bp
|
||||
- ./sx/services:/app/services
|
||||
- ./sx/content:/app/content
|
||||
- ./sx/sx:/app/sx
|
||||
- ./sx/path_setup.py:/app/path_setup.py
|
||||
- ./sx/entrypoint.sh:/usr/local/bin/entrypoint.sh
|
||||
# OCaml SX kernel binary (built with: cd hosts/ocaml && eval $(opam env) && dune build)
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./sx/__init__.py:/app/__init__.py:ro
|
||||
# sibling models for cross-domain SQLAlchemy imports
|
||||
- ./blog/__init__.py:/app/blog/__init__.py:ro
|
||||
- ./blog/models:/app/blog/models:ro
|
||||
- ./market/__init__.py:/app/market/__init__.py:ro
|
||||
- ./market/models:/app/market/models:ro
|
||||
- ./cart/__init__.py:/app/cart/__init__.py:ro
|
||||
- ./cart/models:/app/cart/models:ro
|
||||
- ./events/__init__.py:/app/events/__init__.py:ro
|
||||
- ./events/models:/app/events/models:ro
|
||||
- ./federation/__init__.py:/app/federation/__init__.py:ro
|
||||
- ./federation/models:/app/federation/models:ro
|
||||
- ./account/__init__.py:/app/account/__init__.py:ro
|
||||
- ./account/models:/app/account/models:ro
|
||||
- ./relations/__init__.py:/app/relations/__init__.py:ro
|
||||
- ./relations/models:/app/relations/models:ro
|
||||
- ./likes/__init__.py:/app/likes/__init__.py:ro
|
||||
- ./likes/models:/app/likes/models:ro
|
||||
- ./orders/__init__.py:/app/orders/__init__.py:ro
|
||||
- ./orders/models:/app/orders/models:ro
|
||||
networks:
|
||||
- externalnet
|
||||
- default
|
||||
restart: unless-stopped
|
||||
|
||||
redis:
|
||||
image: redis:7-alpine
|
||||
restart: unless-stopped
|
||||
|
||||
networks:
|
||||
externalnet:
|
||||
external: true
|
||||
@@ -228,6 +228,8 @@ services:
|
||||
<<: *app-env
|
||||
REDIS_URL: redis://redis:6379/10
|
||||
WORKERS: "1"
|
||||
SX_USE_OCAML: "1"
|
||||
SX_OCAML_BIN: "/app/bin/sx_server"
|
||||
|
||||
db:
|
||||
image: postgres:16
|
||||
|
||||
@@ -20,136 +20,147 @@ The key insight: **s-expressions can partially unfold on the server after IO, th
|
||||
|
||||
---
|
||||
|
||||
### Phase 1: Component Distribution & Dependency Analysis
|
||||
### Phase 1: Component Distribution & Dependency Analysis — DONE
|
||||
|
||||
**What it enables:** Per-page component bundles instead of sending every definition to every page. Smaller payloads, faster boot, better cache hit rates.
|
||||
|
||||
**The problem:** `client_components_tag()` in `shared/sx/jinja_bridge.py` serializes ALL entries in `_COMPONENT_ENV`. The `sx_page()` template sends everything or nothing based on a single global hash. No mechanism determines which components a page actually needs.
|
||||
**Implemented:**
|
||||
|
||||
**Approach:**
|
||||
|
||||
1. **Transitive closure analyzer** — new module `shared/sx/deps.py`
|
||||
- Walk `Component.body` AST, collect all `Symbol` refs starting with `~`
|
||||
1. **Transitive closure analyzer** — `shared/sx/deps.py` (now `shared/sx/ref/deps.sx`, spec-level)
|
||||
- Walk component body AST, collect all `~name` refs
|
||||
- Recursively follow into their bodies
|
||||
- Handle control forms (`if`/`when`/`cond`/`case`) — include ALL branches
|
||||
- Handle macros — expand during walk using limited eval
|
||||
- Function: `transitive_deps(name: str, env: dict) -> set[str]`
|
||||
- Cache result on `Component` object (invalidate on hot-reload)
|
||||
- `components_needed(source, env) -> set[str]`
|
||||
|
||||
2. **Runtime component scanning** — after `_aser` serializes page content, scan the SX string for `(~name` patterns (parallel to existing `scan_classes_from_sx` for CSS). Then compute transitive closure to get sub-components.
|
||||
2. **IO reference analysis** — `deps.sx` also tracks IO primitive usage
|
||||
- `scan-io-refs` / `transitive-io-refs` / `component-pure?`
|
||||
- Used by Phase 2 for automatic server/client boundary
|
||||
|
||||
3. **Per-page component block** in `sx_page()` — replace all-or-nothing with page-specific bundle. Hash changes per page, localStorage cache keyed by route pattern.
|
||||
3. **Per-page component block** — `_build_pages_sx()` in `helpers.py`
|
||||
- Each page entry includes `:deps` list of required components
|
||||
- Client page registry carries dep info for prefetching
|
||||
|
||||
4. **SX partial responses** — `components_for_request()` already diffs against `SX-Components` header. Enhance with transitive closure so only truly needed missing components are sent.
|
||||
4. **SX partial responses** — `components_for_request()` diffs against `SX-Components` header, sends only missing components
|
||||
|
||||
**Files:**
|
||||
- New: `shared/sx/deps.py` — dependency analysis
|
||||
- `shared/sx/jinja_bridge.py` — per-page bundle generation, cache deps on Component
|
||||
- `shared/sx/helpers.py` — modify `sx_page()` and `sx_response()` for page-specific bundles
|
||||
- `shared/sx/types.py` — add `deps: set[str]` to Component
|
||||
- `shared/sx/ref/boot.sx` — per-page component caching alongside global cache
|
||||
|
||||
**Verification:**
|
||||
- Page using 5/50 components → `data-components` block contains only those 5 + transitive deps
|
||||
- No "Unknown component" errors after bundle reduction
|
||||
- Payload size reduction measurable
|
||||
**Files:** `shared/sx/ref/deps.sx`, `shared/sx/deps.py`, `shared/sx/helpers.py`, `shared/sx/jinja_bridge.py`
|
||||
|
||||
---
|
||||
|
||||
### Phase 2: Smart Server/Client Boundary
|
||||
### Phase 2: Smart Server/Client Boundary — DONE
|
||||
|
||||
**What it enables:** Formalized partial evaluation model. Server evaluates IO, serializes pure subtrees. The system automatically knows "this component needs server data" vs "this component is pure and can render anywhere."
|
||||
|
||||
**Current mechanism:** `_aser` in `async_eval.py` already does partial evaluation — IO primitives are awaited and substituted, HTML tags and component calls serialize as SX. The `_expand_components` context var controls expansion. But this is a global toggle, not per-component.
|
||||
**Implemented:**
|
||||
|
||||
**Approach:**
|
||||
1. **Automatic IO detection** — `deps.sx` walks component bodies for IO primitive refs
|
||||
- `compute-all-io-refs` computes transitive IO analysis for all components
|
||||
- `component-pure?` returns true if no IO refs transitively
|
||||
|
||||
1. **Automatic IO detection** — extend Phase 1 AST walker to check for references to `IO_PRIMITIVES` names (`frag`, `query`, `service`, `current-user`, etc.)
|
||||
- `has_io_deps(name: str, env: dict) -> bool`
|
||||
- Computed at registration time, cached on Component
|
||||
2. **Selective expansion** — `_aser` expands known components server-side via `_aser_component`
|
||||
- IO-dependent components expand server-side (IO must resolve)
|
||||
- Unknown components serialize for client rendering
|
||||
- `_expand_components` context var controls override
|
||||
|
||||
2. **Component metadata** — enrich Component with analysis results:
|
||||
```python
|
||||
ComponentMeta:
|
||||
deps: set[str] # transitive component deps (Phase 1)
|
||||
io_refs: set[str] # IO primitive names referenced
|
||||
is_pure: bool # True if io_refs empty (transitively)
|
||||
```
|
||||
3. **Component metadata** — computed at registration, cached on Component objects
|
||||
|
||||
3. **Selective expansion** — refine `_aser` (line ~1335): instead of checking a global `_expand_components` flag, check the component's `is_pure` metadata:
|
||||
- IO-dependent → expand server-side (IO must resolve)
|
||||
- Pure → serialize for client (let client render)
|
||||
- Explicit override: `:server true` on defcomp forces server expansion
|
||||
|
||||
4. **Data manifest** for pages — `PageDef` produces a declaration of what IO the page needs, enabling Phase 3 (client can prefetch data) and Phase 5 (streaming).
|
||||
|
||||
**Files:**
|
||||
- `shared/sx/deps.py` — add IO analysis
|
||||
- `shared/sx/types.py` — add metadata fields to Component
|
||||
- `shared/sx/async_eval.py` — refine `_aser` component expansion logic
|
||||
- `shared/sx/jinja_bridge.py` — compute IO metadata at registration
|
||||
- `shared/sx/pages.py` — data manifest on PageDef
|
||||
|
||||
**Verification:**
|
||||
- Components calling `(query ...)` classified IO-dependent; pure components classified pure
|
||||
- Existing pages produce identical output (regression)
|
||||
**Files:** `shared/sx/ref/deps.sx`, `shared/sx/async_eval.py`, `shared/sx/jinja_bridge.py`
|
||||
|
||||
---
|
||||
|
||||
### Phase 3: Client-Side Routing (SPA Mode)
|
||||
### Phase 3: Client-Side Routing (SPA Mode) — DONE
|
||||
|
||||
**What it enables:** After initial page load, client resolves routes locally using cached components + data. Only hits server for fresh data or unknown routes. Like Next.js client-side navigation.
|
||||
**What it enables:** After initial page load, client resolves routes locally using cached components. Only hits server for fresh data or unknown routes.
|
||||
|
||||
**Current mechanism:** All routing is server-side via `defpage` → Quart routes. Client navigates via `sx-boost` links doing `sx-get` + morphing. Every navigation = server roundtrip.
|
||||
**Implemented:**
|
||||
|
||||
**Approach:**
|
||||
1. **Client-side page registry** — `_build_pages_sx()` serializes defpage routing info
|
||||
- `<script type="text/sx-pages">` with name, path, auth, content, deps, closure, has-data
|
||||
- Processed by `boot.sx` → `_page-routes` list
|
||||
|
||||
1. **Client-side page registry** — serialize defpage routing info to client as `<script type="text/sx-pages">`:
|
||||
```json
|
||||
{"docs-page": {"path": "/docs/:slug", "auth": "public",
|
||||
"content": "(case slug ...)", "data": null}}
|
||||
```
|
||||
Pure pages (no `:data`) can be evaluated entirely client-side.
|
||||
2. **Client route matcher** — `shared/sx/ref/router.sx`
|
||||
- `parse-route-pattern` converts Flask-style `/docs/<slug>` to matchers
|
||||
- `find-matching-route` matches URL against registered routes
|
||||
- `match-route-segments` handles literal and param segments
|
||||
|
||||
2. **Client route matcher** — new spec file `shared/sx/ref/router.sx`:
|
||||
- Convert `/docs/<slug>` patterns to matchers
|
||||
- On boost-link click: match URL → if found and pure, evaluate locally
|
||||
- If IO needed: fetch data from server, evaluate content locally
|
||||
- No match: fall through to standard fetch (existing behavior)
|
||||
3. **Client-side route intercept** — `orchestration.sx`
|
||||
- `try-client-route` — match URL, eval content locally, swap DOM
|
||||
- `bind-client-route-link` — intercept boost link clicks
|
||||
- Pure pages render immediately, no server roundtrip
|
||||
- Falls through to server fetch on miss
|
||||
|
||||
3. **Data endpoint** — `GET /internal/page-data/<page-name>?<params>` returns JSON with evaluated `:data` expression. Reuses `execute_page()` logic but stops after `:data` step.
|
||||
4. **Integration with engine** — boost link clicks try client route first, fall back to standard fetch
|
||||
|
||||
4. **Layout caching** — layouts depend on auth/fragments, so cache current layout and reuse across navigations. `SX-Layout-Hash` header tracks staleness.
|
||||
|
||||
5. **Integration with orchestration.sx** — intercept `bind-boost-link` to try client-side resolution first.
|
||||
|
||||
**Files:**
|
||||
- `shared/sx/pages.py` — `serialize_for_client()`, data-only execution path
|
||||
- `shared/sx/helpers.py` — include page registry in `sx_page()`
|
||||
- New: `shared/sx/ref/router.sx` — client-side route matching
|
||||
- `shared/sx/ref/boot.sx` — process `<script type="text/sx-pages">`
|
||||
- `shared/sx/ref/orchestration.sx` — client-side route intercept
|
||||
- Service blueprints — `/internal/page-data/` endpoint
|
||||
|
||||
**Depends on:** Phase 1 (client knows which components each page needs), Phase 2 (which pages are pure vs IO)
|
||||
|
||||
**Verification:**
|
||||
- Pure page navigation: zero server requests
|
||||
- IO page navigation: exactly one data request (not full page fetch)
|
||||
- Browser back/forward works with client-resolved routes
|
||||
- Disabling client registry → identical behavior to current
|
||||
**Files:** `shared/sx/ref/router.sx`, `shared/sx/ref/boot.sx`, `shared/sx/ref/orchestration.sx`, `shared/sx/helpers.py`, `shared/sx/pages.py`
|
||||
|
||||
---
|
||||
|
||||
### Phase 4: Client Async & IO Bridge
|
||||
### Phase 4: Client Async & IO Bridge — DONE
|
||||
|
||||
**What it enables:** Client evaluates IO primitives by mapping them to server REST calls. Same SX code, different transport. `(query "market" "products" :ids "1,2,3")` on server → DB; on client → `fetch("/internal/data/products?ids=1,2,3")`.
|
||||
**What it enables:** Client fetches server-evaluated data and renders `:data` pages locally. Data cached to avoid redundant fetches on back/forward navigation.
|
||||
|
||||
**The approach:** Separate IO from rendering. Server evaluates `:data` expression (async, with DB/service access), serializes result as SX wire format. Client fetches this pre-evaluated data, parses it, merges into env, renders pure `:content` client-side. No continuations needed — all IO happens server-side.
|
||||
|
||||
**Implemented:**
|
||||
|
||||
1. **Abstract `resolve-page-data`** — spec-level primitive in `orchestration.sx`
|
||||
- `(resolve-page-data name params callback)` — platform decides transport
|
||||
- Spec says "I need data for this page"; platform provides concrete implementation
|
||||
- Browser platform: HTTP fetch to `/sx/data/` endpoint
|
||||
|
||||
2. **Server data endpoint** — `pages.py`
|
||||
- `evaluate_page_data()` — evaluates `:data` expression, kebab-cases dict keys, serializes as SX
|
||||
- `auto_mount_page_data()` — mounts `GET /sx/data/<page_name>` endpoint
|
||||
- Per-page auth enforcement via `_check_page_auth()`
|
||||
- Response content type: `text/sx; charset=utf-8`
|
||||
|
||||
3. **Client-side data rendering** — `orchestration.sx`
|
||||
- `try-client-route` handles `:data` pages: fetch data → parse SX → merge into env → render content
|
||||
- Console log: `sx:route client+data <pathname>` confirms client-side rendering
|
||||
- Component deps computed for `:data` pages too (not just pure pages)
|
||||
|
||||
4. **Client data cache** — `orchestration.sx`
|
||||
- `_page-data-cache` dict keyed by `page-name:param=value`
|
||||
- 30s TTL (configurable via `_page-data-cache-ttl`)
|
||||
- Cache hit: `sx:route client+cache <pathname>` — renders instantly
|
||||
- Cache miss: fetches, caches, renders
|
||||
- Stale entries evicted on next access
|
||||
|
||||
5. **Test page** — `sx/sx/data-test.sx`
|
||||
- Exercises full data pipeline: server time, pipeline steps, phase/transport metadata
|
||||
- Navigate from another page → console shows `sx:route client+data`
|
||||
- Navigate back → console shows `sx:route client+cache`
|
||||
|
||||
6. **Unit tests** — `shared/sx/tests/test_page_data.py` (20 tests)
|
||||
- Serialize roundtrip for all data types
|
||||
- Kebab-case key conversion
|
||||
- Component deps for `:data` pages
|
||||
- Full pipeline simulation (serialize → parse → merge → eval)
|
||||
|
||||
**Files:**
|
||||
- `shared/sx/ref/orchestration.sx` — `resolve-page-data` spec, data cache
|
||||
- `shared/sx/ref/bootstrap_js.py` — platform `resolvePageData` implementation
|
||||
- `shared/sx/pages.py` — `evaluate_page_data()`, `auto_mount_page_data()`
|
||||
- `shared/sx/helpers.py` — deps for `:data` pages
|
||||
- `sx/sx/data-test.sx` — test component
|
||||
- `sx/sxc/pages/docs.sx` — test page defpage
|
||||
- `sx/sxc/pages/helpers.py` — `data-test-data` helper
|
||||
- `sx/sx/boundary.sx` — helper declaration
|
||||
- `shared/sx/tests/test_page_data.py` — unit tests
|
||||
|
||||
---
|
||||
|
||||
### Phase 5: Async Continuations & Inline IO
|
||||
|
||||
**What it enables:** Components call IO primitives directly in their body (e.g. `(query ...)`). The evaluator suspends mid-evaluation, fetches data, resumes. Same component source works on both server (Python async/await) and client (continuation-based suspension).
|
||||
|
||||
**The problem:** The existing `shift/reset` continuations extension is synchronous (throw/catch). Client-side IO via `fetch()` returns a Promise, and you can't throw-catch across an async boundary. The evaluator needs Promise-aware continuations.
|
||||
|
||||
**Approach:**
|
||||
|
||||
1. **Async client evaluator** — two possible mechanisms:
|
||||
- **Promise-based:** `evalExpr` returns value or Promise; rendering awaits
|
||||
- **Continuation-based:** use existing `shift/reset` to suspend on IO, resume when data arrives (architecturally cleaner, leverages existing spec)
|
||||
1. **Async-aware shift/reset** — extend the continuations extension:
|
||||
- `sfShift` captures the continuation and returns a Promise
|
||||
- `sfReset` awaits Promise results in the trampoline
|
||||
- Continuation resume feeds the fetched value back into the evaluation
|
||||
|
||||
2. **IO primitive bridge** — register async IO primitives in client `PRIMITIVES`:
|
||||
- `query` → fetch to `/internal/data/`
|
||||
@@ -157,27 +168,22 @@ The key insight: **s-expressions can partially unfold on the server after IO, th
|
||||
- `frag` → fetch fragment HTML
|
||||
- `current-user` → cached from initial page load
|
||||
|
||||
3. **Client data cache** — keyed by `(service, query, params-hash)`, configurable TTL, server can invalidate via `SX-Invalidate` header.
|
||||
3. **CPS transform option** — alternative to Promise-aware shift/reset:
|
||||
- Transform the evaluator to continuation-passing style
|
||||
- Every eval step takes a continuation argument
|
||||
- IO primitives call the continuation after fetch resolves
|
||||
- Architecturally cleaner but requires deeper changes
|
||||
|
||||
4. **Optimistic updates** — extend existing `apply-optimistic`/`revert-optimistic` in `engine.sx` from DOM-level to data-level.
|
||||
|
||||
**Files:**
|
||||
- `shared/sx/ref/eval.sx` — async dispatch path (or new `async-eval.sx`)
|
||||
- New: `shared/sx/ref/io-bridge.sx` — client IO implementations
|
||||
- `shared/sx/ref/boot.sx` — register IO bridge at init
|
||||
- `shared/sx/ref/bootstrap_js.py` — emit async-aware code
|
||||
- `/internal/data/` endpoints — ensure client-accessible (CORS, auth)
|
||||
|
||||
**Depends on:** Phase 2 (IO affinity), Phase 3 (routing for when to trigger IO)
|
||||
**Depends on:** Phase 4 (data endpoint infrastructure)
|
||||
|
||||
**Verification:**
|
||||
- Client `(query ...)` returns identical data to server-side
|
||||
- Data cache prevents redundant fetches
|
||||
- Same component source → identical output on either side
|
||||
- Component calling `(query ...)` on client fetches data and renders
|
||||
- Same component source → identical output on server and client
|
||||
- Suspension visible: placeholder → resolved content
|
||||
|
||||
---
|
||||
|
||||
### Phase 5: Streaming & Suspense
|
||||
### Phase 6: Streaming & Suspense
|
||||
|
||||
**What it enables:** Server streams partially-evaluated SX as IO resolves. Client renders available subtrees immediately, fills in suspended parts. Like React Suspense but built on delimited continuations.
|
||||
|
||||
@@ -203,11 +209,11 @@ The key insight: **s-expressions can partially unfold on the server after IO, th
|
||||
- New: `shared/sx/ref/suspense.sx` — client suspension rendering
|
||||
- `shared/sx/ref/boot.sx` — handle resolution scripts
|
||||
|
||||
**Depends on:** Phase 4 (client async for filling suspended subtrees), Phase 2 (IO analysis for priority)
|
||||
**Depends on:** Phase 5 (async continuations for filling suspended subtrees), Phase 2 (IO analysis for priority)
|
||||
|
||||
---
|
||||
|
||||
### Phase 6: Full Isomorphism
|
||||
### Phase 7: Full Isomorphism
|
||||
|
||||
**What it enables:** Same SX code runs on either side. Runtime chooses optimal split. Offline-first with cached data + client eval.
|
||||
|
||||
@@ -226,11 +232,16 @@ The key insight: **s-expressions can partially unfold on the server after IO, th
|
||||
```
|
||||
Default: auto (runtime decides from IO analysis).
|
||||
|
||||
3. **Offline data layer** — Service Worker intercepts `/internal/data/` requests, serves from IndexedDB when offline, syncs when back online.
|
||||
3. **Optimistic data updates** — extend existing `apply-optimistic`/`revert-optimistic` in `engine.sx` from DOM-level to data-level:
|
||||
- Client updates cached data optimistically (e.g., like button increments count)
|
||||
- Sends mutation to server
|
||||
- If server confirms, keep; if rejects, revert cached data and re-render
|
||||
|
||||
4. **Isomorphic testing** — evaluate same component on Python and JS, compare output. Extends existing `test_sx_ref.py` cross-evaluator comparison.
|
||||
4. **Offline data layer** — Service Worker intercepts `/internal/data/` requests, serves from IndexedDB when offline, syncs when back online.
|
||||
|
||||
5. **Universal page descriptor** — `defpage` is portable: server executes via `execute_page()`, client executes via route match → fetch data → eval content → render DOM. Same descriptor, different execution environment.
|
||||
5. **Isomorphic testing** — evaluate same component on Python and JS, compare output. Extends existing `test_sx_ref.py` cross-evaluator comparison.
|
||||
|
||||
6. **Universal page descriptor** — `defpage` is portable: server executes via `execute_page()`, client executes via route match → fetch data → eval content → render DOM. Same descriptor, different execution environment.
|
||||
|
||||
**Depends on:** All previous phases.
|
||||
|
||||
@@ -259,15 +270,15 @@ All new behavior specified in `.sx` files under `shared/sx/ref/` before implemen
|
||||
|
||||
| File | Role | Phases |
|
||||
|------|------|--------|
|
||||
| `shared/sx/async_eval.py` | Core evaluator, `_aser`, server/client boundary | 2, 5 |
|
||||
| `shared/sx/helpers.py` | `sx_page()`, `sx_response()`, output pipeline | 1, 3 |
|
||||
| `shared/sx/async_eval.py` | Core evaluator, `_aser`, server/client boundary | 2, 6 |
|
||||
| `shared/sx/helpers.py` | `sx_page()`, `sx_response()`, output pipeline | 1, 3, 4 |
|
||||
| `shared/sx/jinja_bridge.py` | `_COMPONENT_ENV`, component registry | 1, 2 |
|
||||
| `shared/sx/pages.py` | `defpage`, `execute_page()`, page lifecycle | 2, 3 |
|
||||
| `shared/sx/ref/boot.sx` | Client boot, component caching | 1, 3, 4 |
|
||||
| `shared/sx/ref/orchestration.sx` | Client fetch/swap/morph | 3, 4 |
|
||||
| `shared/sx/ref/eval.sx` | Evaluator spec | 4 |
|
||||
| `shared/sx/pages.py` | `defpage`, `execute_page()`, page lifecycle, data endpoint | 2, 3, 4 |
|
||||
| `shared/sx/ref/boot.sx` | Client boot, component caching, page registry | 1, 3, 4 |
|
||||
| `shared/sx/ref/orchestration.sx` | Client fetch/swap/morph, routing, data cache | 3, 4, 5 |
|
||||
| `shared/sx/ref/eval.sx` | Evaluator spec | 5 |
|
||||
| `shared/sx/ref/engine.sx` | Morph, swaps, triggers | 3 |
|
||||
| New: `shared/sx/deps.py` | Dependency analysis | 1, 2 |
|
||||
| New: `shared/sx/ref/router.sx` | Client-side routing | 3 |
|
||||
| New: `shared/sx/ref/io-bridge.sx` | Client IO primitives | 4 |
|
||||
| New: `shared/sx/ref/suspense.sx` | Streaming/suspension | 5 |
|
||||
| `shared/sx/ref/deps.sx` | Dependency + IO analysis (spec) | 1, 2 |
|
||||
| `shared/sx/ref/router.sx` | Client-side route matching | 3 |
|
||||
| `shared/sx/ref/bootstrap_js.py` | JS bootstrapper, platform implementations | 4, 5 |
|
||||
| New: `shared/sx/ref/suspense.sx` | Streaming/suspension | 6 |
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Events admin components
|
||||
|
||||
(defcomp ~events-calendar-admin-panel (&key description-content csrf description)
|
||||
(defcomp ~admin/calendar-admin-panel (&key description-content csrf description)
|
||||
(section :class "max-w-3xl mx-auto p-4 space-y-10"
|
||||
(div
|
||||
(h2 :class "text-xl font-semibold" "Calendar configuration")
|
||||
@@ -19,45 +19,45 @@
|
||||
(div (button :class "px-3 py-2 rounded bg-stone-800 text-white" "Save"))))
|
||||
(hr :class "border-stone-200")))
|
||||
|
||||
(defcomp ~events-entry-admin-link (&key href)
|
||||
(defcomp ~admin/entry-admin-link (&key href)
|
||||
(a :href href :class "inline-flex items-center gap-1 px-2 py-1 text-xs text-stone-500 hover:text-stone-700 hover:bg-stone-100 rounded"
|
||||
(i :class "fa fa-cog" :aria-hidden "true") " Admin"))
|
||||
|
||||
(defcomp ~events-entry-field (&key label content)
|
||||
(defcomp ~admin/entry-field (&key label content)
|
||||
(div :class "flex flex-col mb-4"
|
||||
(div :class "text-xs font-semibold uppercase tracking-wide text-stone-500" label)
|
||||
content))
|
||||
|
||||
(defcomp ~events-entry-name-field (&key name)
|
||||
(defcomp ~admin/entry-name-field (&key name)
|
||||
(div :class "mt-1 text-lg font-medium" name))
|
||||
|
||||
(defcomp ~events-entry-slot-assigned (&key slot-name flex-label)
|
||||
(defcomp ~admin/entry-slot-assigned (&key slot-name flex-label)
|
||||
(div :class "mt-1"
|
||||
(span :class "px-2 py-1 rounded text-sm bg-blue-100 text-blue-700" slot-name)
|
||||
(span :class "ml-2 text-xs text-stone-500" flex-label)))
|
||||
|
||||
(defcomp ~events-entry-slot-none ()
|
||||
(defcomp ~admin/entry-slot-none ()
|
||||
(div :class "mt-1" (span :class "text-sm text-stone-400" "No slot assigned")))
|
||||
|
||||
(defcomp ~events-entry-time-field (&key time-str)
|
||||
(defcomp ~admin/entry-time-field (&key time-str)
|
||||
(div :class "mt-1" time-str))
|
||||
|
||||
(defcomp ~events-entry-state-field (&key entry-id badge)
|
||||
(defcomp ~admin/entry-state-field (&key entry-id badge)
|
||||
(div :class "mt-1" (div :id (str "entry-state-" entry-id) badge)))
|
||||
|
||||
(defcomp ~events-entry-cost-field (&key cost)
|
||||
(defcomp ~admin/entry-cost-field (&key cost)
|
||||
(div :class "mt-1" (span :class "font-medium text-green-600" cost)))
|
||||
|
||||
(defcomp ~events-entry-tickets-field (&key entry-id tickets-config)
|
||||
(defcomp ~admin/entry-tickets-field (&key entry-id tickets-config)
|
||||
(div :class "mt-1" :id (str "entry-tickets-" entry-id) tickets-config))
|
||||
|
||||
(defcomp ~events-entry-date-field (&key date-str)
|
||||
(defcomp ~admin/entry-date-field (&key date-str)
|
||||
(div :class "mt-1" date-str))
|
||||
|
||||
(defcomp ~events-entry-posts-field (&key entry-id posts-panel)
|
||||
(defcomp ~admin/entry-posts-field (&key entry-id posts-panel)
|
||||
(div :class "mt-1" :id (str "entry-posts-" entry-id) posts-panel))
|
||||
|
||||
(defcomp ~events-entry-panel (&key entry-id list-container name slot time state cost
|
||||
(defcomp ~admin/entry-panel (&key entry-id list-container name slot time state cost
|
||||
tickets buy date posts options pre-action edit-url)
|
||||
(section :id (str "entry-" entry-id) :class list-container
|
||||
name slot time state cost
|
||||
@@ -68,21 +68,21 @@
|
||||
:sx-get edit-url :sx-target (str "#entry-" entry-id) :sx-swap "outerHTML"
|
||||
"Edit"))))
|
||||
|
||||
(defcomp ~events-entry-title (&key name badge)
|
||||
(defcomp ~admin/entry-title (&key name badge)
|
||||
(<> (i :class "fa fa-clock") " " name " " badge))
|
||||
|
||||
(defcomp ~events-entry-times (&key time-str)
|
||||
(defcomp ~admin/entry-times (&key time-str)
|
||||
(div :class "text-sm text-gray-600" time-str))
|
||||
|
||||
(defcomp ~events-entry-optioned-oob (&key entry-id title state)
|
||||
(defcomp ~admin/entry-optioned-oob (&key entry-id title state)
|
||||
(<> (div :id (str "entry-title-" entry-id) :sx-swap-oob "innerHTML" title)
|
||||
(div :id (str "entry-state-" entry-id) :sx-swap-oob "innerHTML" state)))
|
||||
|
||||
(defcomp ~events-entry-options (&key entry-id buttons)
|
||||
(defcomp ~admin/entry-options (&key entry-id buttons)
|
||||
(div :id (str "calendar_entry_options_" entry-id) :class "flex flex-col md:flex-row gap-1"
|
||||
buttons))
|
||||
|
||||
(defcomp ~events-entry-option-button (&key url target csrf btn-type action-btn confirm-title confirm-text
|
||||
(defcomp ~admin/entry-option-button (&key url target csrf btn-type action-btn confirm-title confirm-text
|
||||
label is-btn)
|
||||
(form :sx-post url :sx-select target :sx-target target :sx-swap "outerHTML"
|
||||
:sx-trigger (if is-btn "confirmed" nil)
|
||||
|
||||
@@ -1,34 +1,34 @@
|
||||
;; Events calendar components
|
||||
|
||||
(defcomp ~events-calendar-nav-arrow (&key pill-cls href label)
|
||||
(defcomp ~calendar/nav-arrow (&key (pill-cls :as string) (href :as string) (label :as string))
|
||||
(a :class (str pill-cls " text-xl") :href href
|
||||
:sx-get href :sx-target "#main-panel" :sx-select "#main-panel" :sx-swap "outerHTML" :sx-push-url "true" label))
|
||||
|
||||
(defcomp ~events-calendar-month-label (&key month-name year)
|
||||
(defcomp ~calendar/month-label (&key (month-name :as string) (year :as string))
|
||||
(div :class "px-3 font-medium" (str month-name " " year)))
|
||||
|
||||
(defcomp ~events-calendar-weekday (&key name)
|
||||
(defcomp ~calendar/weekday (&key (name :as string))
|
||||
(div :class "py-1" name))
|
||||
|
||||
(defcomp ~events-calendar-day-short (&key day-str)
|
||||
(defcomp ~calendar/day-short (&key (day-str :as string))
|
||||
(span :class "sm:hidden text-[16px] text-stone-500" day-str))
|
||||
|
||||
(defcomp ~events-calendar-day-num (&key pill-cls href num)
|
||||
(defcomp ~calendar/day-num (&key (pill-cls :as string) (href :as string) (num :as string))
|
||||
(a :class pill-cls :href href :sx-get href :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true" num))
|
||||
|
||||
(defcomp ~events-calendar-entry-badge (&key bg-cls name state-label)
|
||||
(defcomp ~calendar/entry-badge (&key (bg-cls :as string) (name :as string) (state-label :as string))
|
||||
(div :class (str "flex items-center justify-between gap-1 text-[11px] rounded px-1 py-0.5 " bg-cls)
|
||||
(span :class "truncate" name)
|
||||
(span :class "shrink-0 text-[10px] font-semibold uppercase tracking-tight" state-label)))
|
||||
|
||||
(defcomp ~events-calendar-cell (&key cell-cls day-short day-num badges)
|
||||
(defcomp ~calendar/cell (&key (cell-cls :as string) day-short day-num badges)
|
||||
(div :class cell-cls
|
||||
(div :class "flex justify-between items-center"
|
||||
(div :class "flex flex-col" day-short day-num))
|
||||
(div :class "mt-1 space-y-0.5" badges)))
|
||||
|
||||
(defcomp ~events-calendar-grid (&key arrows weekdays cells)
|
||||
(defcomp ~calendar/grid (&key arrows weekdays cells)
|
||||
(section :class "bg-orange-100"
|
||||
(header :class "flex items-center justify-center mt-2"
|
||||
(nav :class "flex items-center gap-2 text-2xl" arrows))
|
||||
@@ -37,36 +37,36 @@
|
||||
(div :class "grid grid-cols-1 sm:grid-cols-7 gap-px bg-stone-200 rounded-xl overflow-hidden" cells))))
|
||||
|
||||
;; Calendar grid from data — all iteration in sx
|
||||
(defcomp ~events-calendar-grid-from-data (&key pill-cls month-name year
|
||||
prev-year-href prev-month-href
|
||||
next-month-href next-year-href
|
||||
weekday-names cells)
|
||||
(~events-calendar-grid
|
||||
(defcomp ~calendar/grid-from-data (&key (pill-cls :as string) (month-name :as string) (year :as string)
|
||||
(prev-year-href :as string) (prev-month-href :as string)
|
||||
(next-month-href :as string) (next-year-href :as string)
|
||||
(weekday-names :as list) (cells :as list))
|
||||
(~calendar/grid
|
||||
:arrows (<>
|
||||
(~events-calendar-nav-arrow :pill-cls pill-cls :href prev-year-href :label "\u00ab")
|
||||
(~events-calendar-nav-arrow :pill-cls pill-cls :href prev-month-href :label "\u2039")
|
||||
(~events-calendar-month-label :month-name month-name :year year)
|
||||
(~events-calendar-nav-arrow :pill-cls pill-cls :href next-month-href :label "\u203a")
|
||||
(~events-calendar-nav-arrow :pill-cls pill-cls :href next-year-href :label "\u00bb"))
|
||||
:weekdays (<> (map (lambda (wd) (~events-calendar-weekday :name wd))
|
||||
(~calendar/nav-arrow :pill-cls pill-cls :href prev-year-href :label "\u00ab")
|
||||
(~calendar/nav-arrow :pill-cls pill-cls :href prev-month-href :label "\u2039")
|
||||
(~calendar/month-label :month-name month-name :year year)
|
||||
(~calendar/nav-arrow :pill-cls pill-cls :href next-month-href :label "\u203a")
|
||||
(~calendar/nav-arrow :pill-cls pill-cls :href next-year-href :label "\u00bb"))
|
||||
:weekdays (<> (map (lambda (wd) (~calendar/weekday :name wd))
|
||||
(or weekday-names (list))))
|
||||
:cells (<> (map (lambda (cell)
|
||||
(~events-calendar-cell
|
||||
(~calendar/cell
|
||||
:cell-cls (get cell "cell-cls")
|
||||
:day-short (when (get cell "day-str")
|
||||
(~events-calendar-day-short :day-str (get cell "day-str")))
|
||||
(~calendar/day-short :day-str (get cell "day-str")))
|
||||
:day-num (when (get cell "day-href")
|
||||
(~events-calendar-day-num :pill-cls pill-cls
|
||||
(~calendar/day-num :pill-cls pill-cls
|
||||
:href (get cell "day-href") :num (get cell "day-num")))
|
||||
:badges (when (get cell "badges")
|
||||
(<> (map (lambda (b)
|
||||
(~events-calendar-entry-badge
|
||||
(~calendar/entry-badge
|
||||
:bg-cls (get b "bg-cls") :name (get b "name")
|
||||
:state-label (get b "state-label")))
|
||||
(get cell "badges"))))))
|
||||
(or cells (list))))))
|
||||
|
||||
(defcomp ~events-calendar-description-display (&key description edit-url)
|
||||
(defcomp ~calendar/description-display (&key (description :as string?) (edit-url :as string))
|
||||
(div :id "calendar-description"
|
||||
(if description
|
||||
(p :class "text-stone-700 whitespace-pre-line break-all" description)
|
||||
@@ -75,12 +75,12 @@
|
||||
:sx-get edit-url :sx-target "#calendar-description" :sx-swap "outerHTML"
|
||||
(i :class "fas fa-edit"))))
|
||||
|
||||
(defcomp ~events-calendar-description-title-oob (&key description)
|
||||
(defcomp ~calendar/description-title-oob (&key (description :as string))
|
||||
(div :id "calendar-description-title" :sx-swap-oob "outerHTML"
|
||||
:class "text-base font-normal break-words whitespace-normal min-w-0 break-all w-full text-center block"
|
||||
description))
|
||||
|
||||
(defcomp ~events-calendar-description-edit-form (&key save-url cancel-url csrf description)
|
||||
(defcomp ~calendar/description-edit-form (&key (save-url :as string) (cancel-url :as string) (csrf :as string) (description :as string?))
|
||||
(div :id "calendar-description"
|
||||
(form :sx-post save-url :sx-target "#calendar-description" :sx-swap "outerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
|
||||
@@ -1,18 +1,18 @@
|
||||
;; Events day components
|
||||
|
||||
(defcomp ~events-day-entry-link (&key href name time-str)
|
||||
(defcomp ~day/entry-link (&key (href :as string) (name :as string) (time-str :as string))
|
||||
(a :href href :class "flex items-center gap-2 px-3 py-2 hover:bg-stone-100 rounded transition text-sm border sm:whitespace-nowrap sm:flex-shrink-0"
|
||||
(div :class "flex-1 min-w-0"
|
||||
(div :class "font-medium truncate" name)
|
||||
(div :class "text-xs text-stone-600 truncate" time-str))))
|
||||
|
||||
(defcomp ~events-day-entries-nav (&key inner)
|
||||
(defcomp ~day/entries-nav (&key inner)
|
||||
(div :class "flex flex-col sm:flex-row sm:items-center gap-2 border-r border-stone-200 mr-2 sm:max-w-2xl"
|
||||
:id "day-entries-nav-wrapper"
|
||||
(div :class "flex overflow-x-auto gap-1 scrollbar-thin"
|
||||
inner)))
|
||||
|
||||
(defcomp ~events-day-table (&key list-container rows pre-action add-url)
|
||||
(defcomp ~day/table (&key (list-container :as string) rows (pre-action :as string) (add-url :as string))
|
||||
(section :id "day-entries" :class list-container
|
||||
(table :class "w-full text-sm border table-fixed"
|
||||
(thead :class "bg-stone-100"
|
||||
@@ -29,95 +29,95 @@
|
||||
:sx-get add-url :sx-target "#entry-add-container" :sx-swap "innerHTML"
|
||||
"+ Add entry"))))
|
||||
|
||||
(defcomp ~events-day-empty-row ()
|
||||
(defcomp ~day/empty-row ()
|
||||
(tr (td :colspan "6" :class "p-3 text-stone-500" "No entries yet.")))
|
||||
|
||||
(defcomp ~events-day-row-name (&key href pill-cls name)
|
||||
(defcomp ~day/row-name (&key (href :as string) (pill-cls :as string) (name :as string))
|
||||
(td :class "p-2 align-top w-2/6" (div :class "font-medium"
|
||||
(a :href href :class pill-cls :sx-get href :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true" name))))
|
||||
|
||||
(defcomp ~events-day-row-slot (&key href pill-cls slot-name time-str)
|
||||
(defcomp ~day/row-slot (&key (href :as string) (pill-cls :as string) (slot-name :as string) (time-str :as string))
|
||||
(td :class "p-2 align-top w-1/6" (div :class "text-xs font-medium"
|
||||
(a :href href :class pill-cls :sx-get href :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true" slot-name)
|
||||
(span :class "text-stone-600 font-normal" time-str))))
|
||||
|
||||
(defcomp ~events-day-row-time (&key start end)
|
||||
(defcomp ~day/row-time (&key (start :as string) (end :as string))
|
||||
(td :class "p-2 align-top w-1/6" (div :class "text-xs text-stone-600" (str start end))))
|
||||
|
||||
(defcomp ~events-day-row-state (&key state-id badge)
|
||||
(defcomp ~day/row-state (&key (state-id :as string) badge)
|
||||
(td :class "p-2 align-top w-1/6" (div :id state-id badge)))
|
||||
|
||||
(defcomp ~events-day-row-cost (&key cost-str)
|
||||
(defcomp ~day/row-cost (&key (cost-str :as string))
|
||||
(td :class "p-2 align-top w-1/6" (span :class "font-medium text-green-600" cost-str)))
|
||||
|
||||
(defcomp ~events-day-row-tickets (&key price-str count-str)
|
||||
(defcomp ~day/row-tickets (&key (price-str :as string) (count-str :as string))
|
||||
(td :class "p-2 align-top w-1/6" (div :class "text-xs space-y-1"
|
||||
(div :class "font-medium text-green-600" price-str)
|
||||
(div :class "text-stone-600" count-str))))
|
||||
|
||||
(defcomp ~events-day-row-no-tickets ()
|
||||
(defcomp ~day/row-no-tickets ()
|
||||
(td :class "p-2 align-top w-1/6" (span :class "text-xs text-stone-400" "No tickets")))
|
||||
|
||||
(defcomp ~events-day-row-actions ()
|
||||
(defcomp ~day/row-actions ()
|
||||
(td :class "p-2 align-top w-1/6"))
|
||||
|
||||
(defcomp ~events-day-row (&key tr-cls name slot state cost tickets actions)
|
||||
(defcomp ~day/row (&key (tr-cls :as string) name slot state cost tickets actions)
|
||||
(tr :class tr-cls name slot state cost tickets actions))
|
||||
|
||||
(defcomp ~events-day-admin-panel ()
|
||||
(defcomp ~day/admin-panel ()
|
||||
(div :class "p-4 text-sm text-stone-500" "Admin options"))
|
||||
|
||||
(defcomp ~events-day-entries-nav-oob-empty ()
|
||||
(defcomp ~day/entries-nav-oob-empty ()
|
||||
(div :id "day-entries-nav-wrapper" :sx-swap-oob "true"))
|
||||
|
||||
(defcomp ~events-day-entries-nav-oob (&key items)
|
||||
(defcomp ~day/entries-nav-oob (&key items)
|
||||
(div :class "flex flex-col sm:flex-row sm:items-center gap-2 border-r border-stone-200 mr-2 sm:max-w-2xl"
|
||||
:id "day-entries-nav-wrapper" :sx-swap-oob "true"
|
||||
(div :class "flex overflow-x-auto gap-1 scrollbar-thin" items)))
|
||||
|
||||
(defcomp ~events-day-nav-entry (&key href nav-btn name time-str)
|
||||
(defcomp ~day/nav-entry (&key (href :as string) (nav-btn :as string) (name :as string) (time-str :as string))
|
||||
(a :href href :class nav-btn
|
||||
(div :class "flex-1 min-w-0"
|
||||
(div :class "font-medium truncate" name)
|
||||
(div :class "text-xs text-stone-600 truncate" time-str))))
|
||||
|
||||
;; Day table from data — all row iteration in sx
|
||||
(defcomp ~events-day-table-from-data (&key list-container pre-action add-url tr-cls pill-cls rows)
|
||||
(~events-day-table
|
||||
(defcomp ~day/table-from-data (&key (list-container :as string) (pre-action :as string) (add-url :as string) (tr-cls :as string) (pill-cls :as string) (rows :as list?))
|
||||
(~day/table
|
||||
:list-container list-container
|
||||
:rows (if (empty? (or rows (list)))
|
||||
(~events-day-empty-row)
|
||||
(~day/empty-row)
|
||||
(<> (map (lambda (r)
|
||||
(~events-day-row
|
||||
(~day/row
|
||||
:tr-cls tr-cls
|
||||
:name (~events-day-row-name
|
||||
:name (~day/row-name
|
||||
:href (get r "href") :pill-cls pill-cls :name (get r "name"))
|
||||
:slot (if (get r "slot-name")
|
||||
(~events-day-row-slot
|
||||
(~day/row-slot
|
||||
:href (get r "slot-href") :pill-cls pill-cls
|
||||
:slot-name (get r "slot-name") :time-str (get r "slot-time"))
|
||||
(~events-day-row-time :start (get r "start") :end (get r "end")))
|
||||
:state (~events-day-row-state
|
||||
(~day/row-time :start (get r "start") :end (get r "end")))
|
||||
:state (~day/row-state
|
||||
:state-id (get r "state-id")
|
||||
:badge (~entry-state-badge :state (get r "state")))
|
||||
:cost (~events-day-row-cost :cost-str (get r "cost-str"))
|
||||
:badge (~entries/entry-state-badge :state (get r "state")))
|
||||
:cost (~day/row-cost :cost-str (get r "cost-str"))
|
||||
:tickets (if (get r "has-tickets")
|
||||
(~events-day-row-tickets
|
||||
(~day/row-tickets
|
||||
:price-str (get r "price-str") :count-str (get r "count-str"))
|
||||
(~events-day-row-no-tickets))
|
||||
:actions (~events-day-row-actions)))
|
||||
(~day/row-no-tickets))
|
||||
:actions (~day/row-actions)))
|
||||
(or rows (list)))))
|
||||
:pre-action pre-action :add-url add-url))
|
||||
|
||||
;; Day entries nav OOB from data
|
||||
(defcomp ~events-day-entries-nav-oob-from-data (&key nav-btn entries)
|
||||
(defcomp ~day/entries-nav-oob-from-data (&key (nav-btn :as string) (entries :as list?))
|
||||
(if (empty? (or entries (list)))
|
||||
(~events-day-entries-nav-oob-empty)
|
||||
(~events-day-entries-nav-oob
|
||||
(~day/entries-nav-oob-empty)
|
||||
(~day/entries-nav-oob
|
||||
:items (<> (map (lambda (e)
|
||||
(~events-day-nav-entry
|
||||
(~day/nav-entry
|
||||
:href (get e "href") :nav-btn nav-btn
|
||||
:name (get e "name") :time-str (get e "time-str")))
|
||||
entries)))))
|
||||
|
||||
@@ -4,8 +4,8 @@
|
||||
;; State badges — cond maps state string to class + label
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~entry-state-badge (&key state)
|
||||
(~badge
|
||||
(defcomp ~entries/entry-state-badge (&key state)
|
||||
(~shared:misc/badge
|
||||
:cls (cond
|
||||
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
||||
((= state "provisional") "bg-amber-100 text-amber-800")
|
||||
@@ -21,7 +21,7 @@
|
||||
((= state "declined") "Declined")
|
||||
(true (or state "Unknown")))))
|
||||
|
||||
(defcomp ~entry-state-badge-lg (&key state)
|
||||
(defcomp ~entries/entry-state-badge-lg (&key state)
|
||||
(span :class (str "inline-flex items-center rounded-full px-3 py-1 text-sm font-medium "
|
||||
(cond
|
||||
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
||||
@@ -38,8 +38,8 @@
|
||||
((= state "declined") "Declined")
|
||||
(true (or state "Unknown")))))
|
||||
|
||||
(defcomp ~ticket-state-badge (&key state)
|
||||
(~badge
|
||||
(defcomp ~entries/ticket-state-badge (&key state)
|
||||
(~shared:misc/badge
|
||||
:cls (cond
|
||||
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
||||
((= state "checked_in") "bg-blue-100 text-blue-800")
|
||||
@@ -53,7 +53,7 @@
|
||||
((= state "cancelled") "Cancelled")
|
||||
(true (or state "Unknown")))))
|
||||
|
||||
(defcomp ~ticket-state-badge-lg (&key state)
|
||||
(defcomp ~entries/ticket-state-badge-lg (&key state)
|
||||
(span :class (str "inline-flex items-center rounded-full px-3 py-1 text-sm font-medium "
|
||||
(cond
|
||||
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
||||
@@ -73,36 +73,36 @@
|
||||
;; Entry card components
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-entry-title-linked (&key href name)
|
||||
(defcomp ~entries/entry-title-linked (&key href name)
|
||||
(a :href href :class "hover:text-emerald-700"
|
||||
(h2 :class "text-lg font-semibold text-stone-900" name)))
|
||||
|
||||
(defcomp ~events-entry-title-plain (&key name)
|
||||
(defcomp ~entries/entry-title-plain (&key name)
|
||||
(h2 :class "text-lg font-semibold text-stone-900" name))
|
||||
|
||||
(defcomp ~events-entry-title-tile-linked (&key href name)
|
||||
(defcomp ~entries/entry-title-tile-linked (&key href name)
|
||||
(a :href href :class "hover:text-emerald-700"
|
||||
(h2 :class "text-base font-semibold text-stone-900 line-clamp-2" name)))
|
||||
|
||||
(defcomp ~events-entry-title-tile-plain (&key name)
|
||||
(defcomp ~entries/entry-title-tile-plain (&key name)
|
||||
(h2 :class "text-base font-semibold text-stone-900 line-clamp-2" name))
|
||||
|
||||
(defcomp ~events-entry-page-badge (&key href title)
|
||||
(defcomp ~entries/entry-page-badge (&key href title)
|
||||
(a :href href :class "inline-block px-2 py-0.5 rounded-full text-xs font-medium bg-amber-100 text-amber-800 hover:bg-amber-200" title))
|
||||
|
||||
(defcomp ~events-entry-cal-badge (&key name)
|
||||
(defcomp ~entries/entry-cal-badge (&key name)
|
||||
(span :class "inline-block px-2 py-0.5 rounded-full text-xs font-medium bg-sky-100 text-sky-700" name))
|
||||
|
||||
(defcomp ~events-entry-time-linked (&key href date-str)
|
||||
(defcomp ~entries/entry-time-linked (&key href date-str)
|
||||
(<> (a :href href :class "hover:text-stone-700" date-str) " · "))
|
||||
|
||||
(defcomp ~events-entry-time-plain (&key date-str)
|
||||
(defcomp ~entries/entry-time-plain (&key date-str)
|
||||
(<> (span date-str) " · "))
|
||||
|
||||
(defcomp ~events-entry-cost (&key cost)
|
||||
(defcomp ~entries/entry-cost (&key cost)
|
||||
(div :class "mt-1 text-sm font-medium text-green-600" cost))
|
||||
|
||||
(defcomp ~events-entry-card (&key title badges time-parts cost widget)
|
||||
(defcomp ~entries/entry-card (&key title badges time-parts cost widget)
|
||||
(article :class "rounded-xl bg-white shadow-sm border border-stone-200 p-4"
|
||||
(div :class "flex flex-col sm:flex-row sm:items-start justify-between gap-3"
|
||||
(div :class "flex-1 min-w-0"
|
||||
@@ -112,7 +112,7 @@
|
||||
cost)
|
||||
widget)))
|
||||
|
||||
(defcomp ~events-entry-card-tile (&key title badges time cost widget)
|
||||
(defcomp ~entries/entry-card-tile (&key title badges time cost widget)
|
||||
(article :class "rounded-xl bg-white shadow-sm border border-stone-200 overflow-hidden"
|
||||
(div :class "p-3"
|
||||
title
|
||||
@@ -121,20 +121,20 @@
|
||||
cost)
|
||||
widget))
|
||||
|
||||
(defcomp ~events-entry-tile-widget-wrapper (&key widget)
|
||||
(defcomp ~entries/entry-tile-widget-wrapper (&key widget)
|
||||
(div :class "border-t border-stone-100 px-3 py-2" widget))
|
||||
|
||||
(defcomp ~events-entry-widget-wrapper (&key widget)
|
||||
(defcomp ~entries/entry-widget-wrapper (&key widget)
|
||||
(div :class "shrink-0" widget))
|
||||
|
||||
(defcomp ~events-date-separator (&key date-str)
|
||||
(defcomp ~entries/date-separator (&key date-str)
|
||||
(div :class "pt-2 pb-1"
|
||||
(h3 :class "text-sm font-semibold text-stone-500 uppercase tracking-wide" date-str)))
|
||||
|
||||
(defcomp ~events-grid (&key grid-cls cards)
|
||||
(defcomp ~entries/grid (&key grid-cls cards)
|
||||
(div :class grid-cls cards))
|
||||
|
||||
(defcomp ~events-main-panel-body (&key toggle body)
|
||||
(defcomp ~entries/main-panel-body (&key toggle body)
|
||||
(<> toggle body (div :class "pb-8")))
|
||||
|
||||
|
||||
@@ -143,46 +143,46 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Ticket widget from data — replaces _ticket_widget_html Python composition
|
||||
(defcomp ~events-tw-widget-from-data (&key entry-id price qty ticket-url csrf)
|
||||
(~events-tw-widget :entry-id (str entry-id) :price price
|
||||
(defcomp ~entries/tw-widget-from-data (&key entry-id price qty ticket-url csrf)
|
||||
(~page/tw-widget :entry-id (str entry-id) :price price
|
||||
:inner (if (= (or qty 0) 0)
|
||||
(~events-tw-form :ticket-url ticket-url :target (str "#page-ticket-" entry-id)
|
||||
(~page/tw-form :ticket-url ticket-url :target (str "#page-ticket-" entry-id)
|
||||
:csrf csrf :entry-id (str entry-id) :count-val "1"
|
||||
:btn (~events-tw-cart-plus))
|
||||
:btn (~page/tw-cart-plus))
|
||||
(<>
|
||||
(~events-tw-form :ticket-url ticket-url :target (str "#page-ticket-" entry-id)
|
||||
(~page/tw-form :ticket-url ticket-url :target (str "#page-ticket-" entry-id)
|
||||
:csrf csrf :entry-id (str entry-id) :count-val (str (- qty 1))
|
||||
:btn (~events-tw-minus))
|
||||
(~events-tw-cart-icon :qty (str qty))
|
||||
(~events-tw-form :ticket-url ticket-url :target (str "#page-ticket-" entry-id)
|
||||
:btn (~page/tw-minus))
|
||||
(~page/tw-cart-icon :qty (str qty))
|
||||
(~page/tw-form :ticket-url ticket-url :target (str "#page-ticket-" entry-id)
|
||||
:csrf csrf :entry-id (str entry-id) :count-val (str (+ qty 1))
|
||||
:btn (~events-tw-plus))))))
|
||||
:btn (~page/tw-plus))))))
|
||||
|
||||
;; Entry card (list view) from data
|
||||
(defcomp ~events-entry-card-from-data (&key entry-href name day-href
|
||||
(defcomp ~entries/entry-card-from-data (&key entry-href name day-href
|
||||
page-badge-href page-badge-title cal-name
|
||||
date-str start-time end-time is-page-scoped
|
||||
cost has-ticket ticket-data)
|
||||
(~events-entry-card
|
||||
(~entries/entry-card
|
||||
:title (if entry-href
|
||||
(~events-entry-title-linked :href entry-href :name name)
|
||||
(~events-entry-title-plain :name name))
|
||||
(~entries/entry-title-linked :href entry-href :name name)
|
||||
(~entries/entry-title-plain :name name))
|
||||
:badges (<>
|
||||
(when page-badge-title
|
||||
(~events-entry-page-badge :href page-badge-href :title page-badge-title))
|
||||
(~entries/entry-page-badge :href page-badge-href :title page-badge-title))
|
||||
(when cal-name
|
||||
(~events-entry-cal-badge :name cal-name)))
|
||||
(~entries/entry-cal-badge :name cal-name)))
|
||||
:time-parts (<>
|
||||
(when (and day-href (not is-page-scoped))
|
||||
(~events-entry-time-linked :href day-href :date-str date-str))
|
||||
(~entries/entry-time-linked :href day-href :date-str date-str))
|
||||
(when (and (not day-href) (not is-page-scoped) date-str)
|
||||
(~events-entry-time-plain :date-str date-str))
|
||||
(~entries/entry-time-plain :date-str date-str))
|
||||
start-time
|
||||
(when end-time (str " \u2013 " end-time)))
|
||||
:cost (when cost (~events-entry-cost :cost cost))
|
||||
:cost (when cost (~entries/entry-cost :cost cost))
|
||||
:widget (when has-ticket
|
||||
(~events-entry-widget-wrapper
|
||||
:widget (~events-tw-widget-from-data
|
||||
(~entries/entry-widget-wrapper
|
||||
:widget (~entries/tw-widget-from-data
|
||||
:entry-id (get ticket-data "entry-id")
|
||||
:price (get ticket-data "price")
|
||||
:qty (get ticket-data "qty")
|
||||
@@ -190,24 +190,24 @@
|
||||
:csrf (get ticket-data "csrf"))))))
|
||||
|
||||
;; Entry card (tile view) from data
|
||||
(defcomp ~events-entry-card-tile-from-data (&key entry-href name day-href
|
||||
(defcomp ~entries/entry-card-tile-from-data (&key entry-href name day-href
|
||||
page-badge-href page-badge-title cal-name
|
||||
date-str time-str
|
||||
cost has-ticket ticket-data)
|
||||
(~events-entry-card-tile
|
||||
(~entries/entry-card-tile
|
||||
:title (if entry-href
|
||||
(~events-entry-title-tile-linked :href entry-href :name name)
|
||||
(~events-entry-title-tile-plain :name name))
|
||||
(~entries/entry-title-tile-linked :href entry-href :name name)
|
||||
(~entries/entry-title-tile-plain :name name))
|
||||
:badges (<>
|
||||
(when page-badge-title
|
||||
(~events-entry-page-badge :href page-badge-href :title page-badge-title))
|
||||
(~entries/entry-page-badge :href page-badge-href :title page-badge-title))
|
||||
(when cal-name
|
||||
(~events-entry-cal-badge :name cal-name)))
|
||||
(~entries/entry-cal-badge :name cal-name)))
|
||||
:time time-str
|
||||
:cost (when cost (~events-entry-cost :cost cost))
|
||||
:cost (when cost (~entries/entry-cost :cost cost))
|
||||
:widget (when has-ticket
|
||||
(~events-entry-tile-widget-wrapper
|
||||
:widget (~events-tw-widget-from-data
|
||||
(~entries/entry-tile-widget-wrapper
|
||||
:widget (~entries/tw-widget-from-data
|
||||
:entry-id (get ticket-data "entry-id")
|
||||
:price (get ticket-data "price")
|
||||
:qty (get ticket-data "qty")
|
||||
@@ -215,13 +215,13 @@
|
||||
:csrf (get ticket-data "csrf"))))))
|
||||
|
||||
;; Entry cards list (with date separators + sentinel) from data
|
||||
(defcomp ~events-entry-cards-from-data (&key items view page has-more next-url)
|
||||
(defcomp ~entries/entry-cards-from-data (&key items view page has-more next-url)
|
||||
(<>
|
||||
(map (lambda (item)
|
||||
(if (get item "is-separator")
|
||||
(~events-date-separator :date-str (get item "date-str"))
|
||||
(~entries/date-separator :date-str (get item "date-str"))
|
||||
(if (= view "tile")
|
||||
(~events-entry-card-tile-from-data
|
||||
(~entries/entry-card-tile-from-data
|
||||
:entry-href (get item "entry-href") :name (get item "name")
|
||||
:day-href (get item "day-href")
|
||||
:page-badge-href (get item "page-badge-href")
|
||||
@@ -230,7 +230,7 @@
|
||||
:date-str (get item "date-str") :time-str (get item "time-str")
|
||||
:cost (get item "cost") :has-ticket (get item "has-ticket")
|
||||
:ticket-data (get item "ticket-data"))
|
||||
(~events-entry-card-from-data
|
||||
(~entries/entry-card-from-data
|
||||
:entry-href (get item "entry-href") :name (get item "name")
|
||||
:day-href (get item "day-href")
|
||||
:page-badge-href (get item "page-badge-href")
|
||||
@@ -243,20 +243,20 @@
|
||||
:ticket-data (get item "ticket-data")))))
|
||||
(or items (list)))
|
||||
(when has-more
|
||||
(~sentinel-simple :id (str "sentinel-" page) :next-url next-url))))
|
||||
(~shared:misc/sentinel-simple :id (str "sentinel-" page) :next-url next-url))))
|
||||
|
||||
;; Events main panel (toggle + cards grid) from data
|
||||
(defcomp ~events-main-panel-from-data (&key toggle items view page has-more next-url)
|
||||
(~events-main-panel-body
|
||||
(defcomp ~entries/main-panel-from-data (&key toggle items view page has-more next-url)
|
||||
(~entries/main-panel-body
|
||||
:toggle toggle
|
||||
:body (if items
|
||||
(~events-grid
|
||||
(~entries/grid
|
||||
:grid-cls (if (= view "tile")
|
||||
"max-w-full px-3 py-3 grid grid-cols-1 sm:grid-cols-2 md:grid-cols-3 gap-4"
|
||||
"max-w-full px-3 py-3 space-y-3")
|
||||
:cards (~events-entry-cards-from-data
|
||||
:cards (~entries/entry-cards-from-data
|
||||
:items items :view view :page page
|
||||
:has-more has-more :next-url next-url))
|
||||
(~empty-state :icon "fa fa-calendar-xmark"
|
||||
(~shared:misc/empty-state :icon "fa fa-calendar-xmark"
|
||||
:message "No upcoming events"
|
||||
:cls "px-3 py-12 text-center text-stone-400"))))
|
||||
|
||||
@@ -5,25 +5,25 @@
|
||||
;; Slot picker option (shared by entry-edit and entry-add)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-slot-option (&key value data-start data-end data-flexible data-cost selected label)
|
||||
(defcomp ~forms/slot-option (&key value data-start data-end data-flexible data-cost selected label)
|
||||
(option :value value :data-start data-start :data-end data-end
|
||||
:data-flexible data-flexible :data-cost data-cost
|
||||
:selected selected
|
||||
label))
|
||||
|
||||
(defcomp ~events-slot-picker (&key id options)
|
||||
(defcomp ~forms/slot-picker (&key id options)
|
||||
(select :id id :name "slot_id" :class "w-full border p-2 rounded"
|
||||
:data-slot-picker "" :required "required"
|
||||
options))
|
||||
|
||||
(defcomp ~events-no-slots ()
|
||||
(defcomp ~forms/no-slots ()
|
||||
(div :class "text-sm text-stone-500" "No slots defined for this day."))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Entry edit form (_types/entry/_edit.html)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-entry-edit-form (&key entry-id list-container put-url cancel-url csrf
|
||||
(defcomp ~forms/entry-edit-form (&key entry-id list-container put-url cancel-url csrf
|
||||
name-val slot-picker
|
||||
start-val end-val cost-display
|
||||
ticket-price-val ticket-count-val
|
||||
@@ -115,7 +115,7 @@
|
||||
;; Post search results (_types/entry/_post_search_results.html)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-post-search-item (&key post-url entry-id csrf post-id
|
||||
(defcomp ~forms/post-search-item (&key post-url entry-id csrf post-id
|
||||
img title)
|
||||
(form :sx-post post-url :sx-target (str "#entry-posts-" entry-id) :sx-swap "innerHTML"
|
||||
:class "p-2 hover:bg-stone-50 cursor-pointer rounded text-sm border-b"
|
||||
@@ -129,7 +129,7 @@
|
||||
:data-confirm-cancel-text "Cancel"
|
||||
img (span title))))
|
||||
|
||||
(defcomp ~events-post-search-sentinel (&key page next-url)
|
||||
(defcomp ~forms/post-search-sentinel (&key page next-url)
|
||||
(div :id (str "post-search-sentinel-" page)
|
||||
:sx-get next-url
|
||||
:sx-trigger "intersect once delay:250ms, sentinel:retry"
|
||||
@@ -172,7 +172,7 @@
|
||||
(div :class "text-xs text-center text-stone-400 js-loading" "Loading more...")
|
||||
(div :class "text-xs text-center text-stone-400 js-neterr hidden" "Connection error. Retrying...")))
|
||||
|
||||
(defcomp ~events-post-search-end ()
|
||||
(defcomp ~forms/post-search-end ()
|
||||
(div :class "py-2 text-xs text-center text-stone-400" "End of results"))
|
||||
|
||||
|
||||
@@ -180,17 +180,17 @@
|
||||
;; Slot edit form (_types/slot/_edit.html)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-day-checkbox (&key name label checked)
|
||||
(defcomp ~forms/day-checkbox (&key name label checked)
|
||||
(label :class "flex items-center gap-1 px-2 py-1 rounded-full bg-slate-100"
|
||||
(input :type "checkbox" :name name :value "1" :data-day name :checked checked)
|
||||
(span label)))
|
||||
|
||||
(defcomp ~events-day-all-checkbox (&key checked)
|
||||
(defcomp ~forms/day-all-checkbox (&key checked)
|
||||
(label :class "flex items-center gap-1 px-2 py-1 rounded-full bg-slate-200"
|
||||
(input :type "checkbox" :data-day-all "" :checked checked)
|
||||
(span "All")))
|
||||
|
||||
(defcomp ~events-slot-edit-form (&key slot-id list-container put-url cancel-url csrf
|
||||
(defcomp ~forms/slot-edit-form (&key slot-id list-container put-url cancel-url csrf
|
||||
name-val cost-val start-val end-val desc-val
|
||||
days flexible-checked
|
||||
action-btn cancel-btn)
|
||||
@@ -271,7 +271,7 @@
|
||||
;; Slot add form (_types/slots/_add.html)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-slot-add-form (&key post-url csrf days action-btn cancel-btn cancel-url)
|
||||
(defcomp ~forms/slot-add-form (&key post-url csrf days action-btn cancel-btn cancel-url)
|
||||
(form :sx-post post-url :sx-target "#slots-table" :sx-select "#slots-table"
|
||||
:sx-disinherit "sx-select" :sx-swap "outerHTML"
|
||||
:sx-headers csrf :class "space-y-3"
|
||||
@@ -312,7 +312,7 @@
|
||||
:data-confirm-cancel-text "Cancel"
|
||||
(i :class "fa fa-save") " Save slot"))))
|
||||
|
||||
(defcomp ~events-slot-add-button (&key pre-action add-url)
|
||||
(defcomp ~forms/slot-add-button (&key pre-action add-url)
|
||||
(button :type "button" :class pre-action
|
||||
:sx-get add-url :sx-target "#slot-add-container" :sx-swap "innerHTML"
|
||||
"+ Add slot"))
|
||||
@@ -323,20 +323,20 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Day checkboxes from data — replaces Python loop
|
||||
(defcomp ~events-day-checkboxes-from-data (&key days-data all-checked)
|
||||
(defcomp ~forms/day-checkboxes-from-data (&key days-data all-checked)
|
||||
(<>
|
||||
(~events-day-all-checkbox :checked (when all-checked "checked"))
|
||||
(~forms/day-all-checkbox :checked (when all-checked "checked"))
|
||||
(map (lambda (d)
|
||||
(~events-day-checkbox
|
||||
(~forms/day-checkbox
|
||||
:name (get d "name")
|
||||
:label (get d "label")
|
||||
:checked (when (get d "checked") "checked")))
|
||||
(or days-data (list)))))
|
||||
|
||||
;; Slot options from data — replaces _slot_options_html Python loop
|
||||
(defcomp ~events-slot-options-from-data (&key slots)
|
||||
(defcomp ~forms/slot-options-from-data (&key slots)
|
||||
(<> (map (lambda (s)
|
||||
(~events-slot-option
|
||||
(~forms/slot-option
|
||||
:value (get s "value")
|
||||
:data-start (get s "data-start")
|
||||
:data-end (get s "data-end")
|
||||
@@ -347,32 +347,32 @@
|
||||
(or slots (list)))))
|
||||
|
||||
;; Slot picker from data — wraps picker + options
|
||||
(defcomp ~events-slot-picker-from-data (&key id slots)
|
||||
(defcomp ~forms/slot-picker-from-data (&key id slots)
|
||||
(if (empty? (or slots (list)))
|
||||
(~events-no-slots)
|
||||
(~events-slot-picker
|
||||
(~forms/no-slots)
|
||||
(~forms/slot-picker
|
||||
:id id
|
||||
:options (~events-slot-options-from-data :slots slots))))
|
||||
:options (~forms/slot-options-from-data :slots slots))))
|
||||
|
||||
;; Slot edit form from data
|
||||
(defcomp ~events-slot-edit-form-from-data (&key slot-id list-container put-url cancel-url csrf
|
||||
(defcomp ~forms/slot-edit-form-from-data (&key slot-id list-container put-url cancel-url csrf
|
||||
name-val cost-val start-val end-val desc-val
|
||||
days-data all-checked flexible-checked
|
||||
action-btn cancel-btn)
|
||||
(~events-slot-edit-form
|
||||
(~forms/slot-edit-form
|
||||
:slot-id slot-id :list-container list-container
|
||||
:put-url put-url :cancel-url cancel-url :csrf csrf
|
||||
:name-val name-val :cost-val cost-val :start-val start-val
|
||||
:end-val end-val :desc-val desc-val
|
||||
:days (~events-day-checkboxes-from-data :days-data days-data :all-checked all-checked)
|
||||
:days (~forms/day-checkboxes-from-data :days-data days-data :all-checked all-checked)
|
||||
:flexible-checked flexible-checked
|
||||
:action-btn action-btn :cancel-btn cancel-btn))
|
||||
|
||||
;; Slot add form from data
|
||||
(defcomp ~events-slot-add-form-from-data (&key post-url csrf days-data action-btn cancel-btn cancel-url)
|
||||
(~events-slot-add-form
|
||||
(defcomp ~forms/slot-add-form-from-data (&key post-url csrf days-data action-btn cancel-btn cancel-url)
|
||||
(~forms/slot-add-form
|
||||
:post-url post-url :csrf csrf
|
||||
:days (~events-day-checkboxes-from-data :days-data days-data)
|
||||
:days (~forms/day-checkboxes-from-data :days-data days-data)
|
||||
:action-btn action-btn :cancel-btn cancel-btn :cancel-url cancel-url))
|
||||
|
||||
|
||||
@@ -380,7 +380,7 @@
|
||||
;; Entry add form (_types/day/_add.html)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-entry-add-form (&key post-url csrf slot-picker
|
||||
(defcomp ~forms/entry-add-form (&key post-url csrf slot-picker
|
||||
action-btn cancel-btn cancel-url)
|
||||
(<>
|
||||
(div :id "entry-errors" :class "mt-2 text-sm text-red-600")
|
||||
@@ -446,7 +446,7 @@
|
||||
:data-confirm-cancel-text "Cancel"
|
||||
(i :class "fa fa-save") " Save entry")))))
|
||||
|
||||
(defcomp ~events-entry-add-button (&key pre-action add-url)
|
||||
(defcomp ~forms/entry-add-button (&key pre-action add-url)
|
||||
(button :type "button" :class pre-action
|
||||
:sx-get add-url :sx-target "#entry-add-container" :sx-swap "innerHTML"
|
||||
"+ Add entry"))
|
||||
@@ -456,7 +456,7 @@
|
||||
;; Ticket type edit form (_types/ticket_type/_edit.html)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-ticket-type-edit-form (&key ticket-id list-container put-url cancel-url csrf
|
||||
(defcomp ~forms/ticket-type-edit-form (&key ticket-id list-container put-url cancel-url csrf
|
||||
name-val cost-val count-val
|
||||
action-btn cancel-btn)
|
||||
(section :id (str "ticket-" ticket-id) :class list-container
|
||||
@@ -509,7 +509,7 @@
|
||||
;; Ticket type add form (_types/ticket_types/_add.html)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-ticket-type-add-form (&key post-url csrf action-btn cancel-btn cancel-url)
|
||||
(defcomp ~forms/ticket-type-add-form (&key post-url csrf action-btn cancel-btn cancel-url)
|
||||
(form :sx-post post-url :sx-target "#tickets-table" :sx-select "#tickets-table"
|
||||
:sx-disinherit "sx-select" :sx-swap "outerHTML"
|
||||
:sx-headers csrf :class "space-y-3"
|
||||
@@ -540,7 +540,7 @@
|
||||
:data-confirm-cancel-text "Cancel"
|
||||
(i :class "fa fa-save") " Save ticket type"))))
|
||||
|
||||
(defcomp ~events-ticket-type-add-button (&key action-btn add-url)
|
||||
(defcomp ~forms/ticket-type-add-button (&key action-btn add-url)
|
||||
(button :class action-btn
|
||||
:sx-get add-url :sx-target "#ticket-add-container" :sx-swap "innerHTML"
|
||||
(i :class "fa fa-plus") " Add ticket type"))
|
||||
@@ -550,6 +550,6 @@
|
||||
;; Entry admin nav — placeholder
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-admin-placeholder-nav ()
|
||||
(defcomp ~forms/admin-placeholder-nav ()
|
||||
(div :class "relative nav-group"
|
||||
(span :class "block px-3 py-2 text-stone-400 text-sm italic" "Admin options")))
|
||||
@@ -5,14 +5,14 @@
|
||||
;; Container cards entries (fragments/container_cards_entries.html)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-frag-entry-card (&key href name date-str time-str)
|
||||
(defcomp ~fragments/frag-entry-card (&key href name date-str time-str)
|
||||
(a :href href
|
||||
:class "flex flex-col gap-1 px-3 py-2 bg-stone-50 hover:bg-stone-100 rounded border border-stone-200 transition text-sm whitespace-nowrap flex-shrink-0 min-w-[180px]"
|
||||
(div :class "font-medium text-stone-900 truncate" name)
|
||||
(div :class "text-xs text-stone-600" date-str)
|
||||
(div :class "text-xs text-stone-500" time-str)))
|
||||
|
||||
(defcomp ~events-frag-entries-widget (&key cards)
|
||||
(defcomp ~fragments/frag-entries-widget (&key cards)
|
||||
(div :class "mt-4 mb-2"
|
||||
(h3 :class "text-sm font-semibold text-stone-700 mb-2 px-2" "Events:")
|
||||
(div :class "overflow-x-auto scrollbar-hide" :style "scroll-behavior: smooth;"
|
||||
@@ -23,7 +23,7 @@
|
||||
;; Account page tickets (fragments/account_page_tickets.html)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-frag-ticket-item (&key href entry-name date-str calendar-name type-name badge)
|
||||
(defcomp ~fragments/frag-ticket-item (&key href entry-name date-str calendar-name type-name badge)
|
||||
(div :class "py-4 first:pt-0 last:pb-0"
|
||||
(div :class "flex items-start justify-between gap-4"
|
||||
(div :class "min-w-0 flex-1"
|
||||
@@ -35,13 +35,13 @@
|
||||
type-name))
|
||||
(div :class "flex-shrink-0" badge))))
|
||||
|
||||
(defcomp ~events-frag-tickets-panel (&key items)
|
||||
(defcomp ~fragments/frag-tickets-panel (&key items)
|
||||
(div :class "w-full max-w-3xl mx-auto px-4 py-6"
|
||||
(div :class "bg-white/70 backdrop-blur rounded-2xl shadow border border-stone-200 p-6 sm:p-8 space-y-6"
|
||||
(h1 :class "text-xl font-semibold tracking-tight" "Tickets")
|
||||
items)))
|
||||
|
||||
(defcomp ~events-frag-tickets-list (&key items)
|
||||
(defcomp ~fragments/frag-tickets-list (&key items)
|
||||
(div :class "divide-y divide-stone-100" items))
|
||||
|
||||
|
||||
@@ -49,7 +49,7 @@
|
||||
;; Account page bookings (fragments/account_page_bookings.html)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-frag-booking-item (&key name date-str calendar-name cost-str badge)
|
||||
(defcomp ~fragments/frag-booking-item (&key name date-str calendar-name cost-str badge)
|
||||
(div :class "py-4 first:pt-0 last:pb-0"
|
||||
(div :class "flex items-start justify-between gap-4"
|
||||
(div :class "min-w-0 flex-1"
|
||||
@@ -60,13 +60,13 @@
|
||||
cost-str))
|
||||
(div :class "flex-shrink-0" badge))))
|
||||
|
||||
(defcomp ~events-frag-bookings-panel (&key items)
|
||||
(defcomp ~fragments/frag-bookings-panel (&key items)
|
||||
(div :class "w-full max-w-3xl mx-auto px-4 py-6"
|
||||
(div :class "bg-white/70 backdrop-blur rounded-2xl shadow border border-stone-200 p-6 sm:p-8 space-y-6"
|
||||
(h1 :class "text-xl font-semibold tracking-tight" "Bookings")
|
||||
items)))
|
||||
|
||||
(defcomp ~events-frag-bookings-list (&key items)
|
||||
(defcomp ~fragments/frag-bookings-list (&key items)
|
||||
(div :class "divide-y divide-stone-100" items))
|
||||
|
||||
|
||||
@@ -75,12 +75,12 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Container cards: list of widgets, each with entries
|
||||
(defcomp ~events-frag-container-cards-from-data (&key widgets)
|
||||
(defcomp ~fragments/frag-container-cards-from-data (&key widgets)
|
||||
(<> (map (lambda (w)
|
||||
(if (get w "entries")
|
||||
(~events-frag-entries-widget
|
||||
(~fragments/frag-entries-widget
|
||||
:cards (<> (map (lambda (e)
|
||||
(~events-frag-entry-card
|
||||
(~fragments/frag-entry-card
|
||||
:href (get e "href") :name (get e "name")
|
||||
:date-str (get e "date-str") :time-str (get e "time-str")))
|
||||
(get w "entries"))))
|
||||
@@ -88,43 +88,43 @@
|
||||
(or widgets (list)))))
|
||||
|
||||
;; Ticket item from data — composes badge + optional spans
|
||||
(defcomp ~events-frag-ticket-item-from-data (&key href entry-name date-str calendar-name type-name state)
|
||||
(~events-frag-ticket-item
|
||||
(defcomp ~fragments/frag-ticket-item-from-data (&key href entry-name date-str calendar-name type-name state)
|
||||
(~fragments/frag-ticket-item
|
||||
:href href :entry-name entry-name :date-str date-str
|
||||
:calendar-name (when calendar-name (span "\u00b7 " calendar-name))
|
||||
:type-name (when type-name (span "\u00b7 " type-name))
|
||||
:badge (~status-pill :status state)))
|
||||
:badge (~shared:controls/status-pill :status state)))
|
||||
|
||||
;; Tickets panel from data — full panel with list iteration
|
||||
(defcomp ~events-frag-tickets-panel-from-data (&key tickets)
|
||||
(~events-frag-tickets-panel
|
||||
(defcomp ~fragments/frag-tickets-panel-from-data (&key tickets)
|
||||
(~fragments/frag-tickets-panel
|
||||
:items (if (empty? (or tickets (list)))
|
||||
(~empty-state :message "No tickets yet." :cls "text-sm text-stone-500")
|
||||
(~events-frag-tickets-list
|
||||
(~shared:misc/empty-state :message "No tickets yet." :cls "text-sm text-stone-500")
|
||||
(~fragments/frag-tickets-list
|
||||
:items (<> (map (lambda (t)
|
||||
(~events-frag-ticket-item-from-data
|
||||
(~fragments/frag-ticket-item-from-data
|
||||
:href (get t "href") :entry-name (get t "entry-name")
|
||||
:date-str (get t "date-str") :calendar-name (get t "calendar-name")
|
||||
:type-name (get t "type-name") :state (get t "state")))
|
||||
tickets))))))
|
||||
|
||||
;; Booking item from data — composes badge + optional spans
|
||||
(defcomp ~events-frag-booking-item-from-data (&key name date-str end-time calendar-name cost-str state)
|
||||
(~events-frag-booking-item
|
||||
(defcomp ~fragments/frag-booking-item-from-data (&key name date-str end-time calendar-name cost-str state)
|
||||
(~fragments/frag-booking-item
|
||||
:name name
|
||||
:date-str (<> date-str (when end-time (span "\u2013 " end-time)))
|
||||
:calendar-name (when calendar-name (span "\u00b7 " calendar-name))
|
||||
:cost-str (when cost-str (span "\u00b7 \u00a3" cost-str))
|
||||
:badge (~status-pill :status state)))
|
||||
:badge (~shared:controls/status-pill :status state)))
|
||||
|
||||
;; Bookings panel from data — full panel with list iteration
|
||||
(defcomp ~events-frag-bookings-panel-from-data (&key bookings)
|
||||
(~events-frag-bookings-panel
|
||||
(defcomp ~fragments/frag-bookings-panel-from-data (&key bookings)
|
||||
(~fragments/frag-bookings-panel
|
||||
:items (if (empty? (or bookings (list)))
|
||||
(~empty-state :message "No bookings yet." :cls "text-sm text-stone-500")
|
||||
(~events-frag-bookings-list
|
||||
(~shared:misc/empty-state :message "No bookings yet." :cls "text-sm text-stone-500")
|
||||
(~fragments/frag-bookings-list
|
||||
:items (<> (map (lambda (b)
|
||||
(~events-frag-booking-item-from-data
|
||||
(~fragments/frag-booking-item-from-data
|
||||
:href (get b "href") :name (get b "name")
|
||||
:date-str (get b "date-str") :end-time (get b "end-time")
|
||||
:calendar-name (get b "calendar-name") :cost-str (get b "cost-str")
|
||||
|
||||
@@ -8,12 +8,12 @@
|
||||
(nav-class (or (get styles "nav_button") ""))
|
||||
(hx-select "#main-panel, #search-mobile, #search-count-mobile, #search-desktop, #search-count-desktop, #menu-items-nav-wrapper"))
|
||||
(<>
|
||||
(~nav-group-link
|
||||
(~shared:misc/nav-group-link
|
||||
:href (app-url "account" "/tickets/")
|
||||
:hx-select hx-select
|
||||
:nav-class nav-class
|
||||
:label "tickets")
|
||||
(~nav-group-link
|
||||
(~shared:misc/nav-group-link
|
||||
:href (app-url "account" "/bookings/")
|
||||
:hx-select hx-select
|
||||
:nav-class nav-class
|
||||
|
||||
@@ -10,13 +10,13 @@
|
||||
(cond
|
||||
(= slug "tickets")
|
||||
(let ((tickets (service "calendar" "user-tickets" :user-id uid)))
|
||||
(~events-frag-tickets-panel
|
||||
(~fragments/frag-tickets-panel
|
||||
:items (if (empty? tickets)
|
||||
(~empty-state :message "No tickets yet."
|
||||
(~shared:misc/empty-state :message "No tickets yet."
|
||||
:cls "text-sm text-stone-500")
|
||||
(~events-frag-tickets-list
|
||||
(~fragments/frag-tickets-list
|
||||
:items (<> (map (fn (t)
|
||||
(~events-frag-ticket-item
|
||||
(~fragments/frag-ticket-item
|
||||
:href (app-url "events"
|
||||
(str "/tickets/" (get t "code") "/"))
|
||||
:entry-name (get t "entry_name")
|
||||
@@ -25,18 +25,18 @@
|
||||
(span (str "\u00b7 " (get t "calendar_name"))))
|
||||
:type-name (when (get t "ticket_type_name")
|
||||
(span (str "\u00b7 " (get t "ticket_type_name"))))
|
||||
:badge (~status-pill :status (or (get t "state") ""))))
|
||||
:badge (~shared:controls/status-pill :status (or (get t "state") ""))))
|
||||
tickets))))))
|
||||
|
||||
(= slug "bookings")
|
||||
(let ((bookings (service "calendar" "user-bookings" :user-id uid)))
|
||||
(~events-frag-bookings-panel
|
||||
(~fragments/frag-bookings-panel
|
||||
:items (if (empty? bookings)
|
||||
(~empty-state :message "No bookings yet."
|
||||
(~shared:misc/empty-state :message "No bookings yet."
|
||||
:cls "text-sm text-stone-500")
|
||||
(~events-frag-bookings-list
|
||||
(~fragments/frag-bookings-list
|
||||
:items (<> (map (fn (b)
|
||||
(~events-frag-booking-item
|
||||
(~fragments/frag-booking-item
|
||||
:name (get b "name")
|
||||
:date-str (str (format-date (get b "start_at") "%d %b %Y, %H:%M")
|
||||
(if (get b "end_at")
|
||||
@@ -46,5 +46,5 @@
|
||||
(span (str "\u00b7 " (get b "calendar_name"))))
|
||||
:cost-str (when (get b "cost")
|
||||
(span (str "\u00b7 \u00a3" (get b "cost"))))
|
||||
:badge (~status-pill :status (or (get b "state") ""))))
|
||||
:badge (~shared:controls/status-pill :status (or (get b "state") ""))))
|
||||
bookings))))))))))
|
||||
|
||||
@@ -19,13 +19,13 @@
|
||||
(post-slug (or (nth slugs i) "")))
|
||||
(<> (str "<!-- card-widget:" pid " -->")
|
||||
(when (not (empty? entries))
|
||||
(~events-frag-entries-widget
|
||||
(~fragments/frag-entries-widget
|
||||
:cards (<> (map (fn (e)
|
||||
(let ((time-str (str (format-date (get e "start_at") "%H:%M")
|
||||
(if (get e "end_at")
|
||||
(str " \u2013 " (format-date (get e "end_at") "%H:%M"))
|
||||
""))))
|
||||
(~events-frag-entry-card
|
||||
(~fragments/frag-entry-card
|
||||
:href (app-url "events"
|
||||
(str "/" post-slug
|
||||
"/" (get e "calendar_slug")
|
||||
|
||||
@@ -53,7 +53,7 @@
|
||||
(if (get entry "end_at")
|
||||
(str " – " (format-date (get entry "end_at") "%H:%M"))
|
||||
""))))
|
||||
(~calendar-entry-nav
|
||||
(~shared:navigation/calendar-entry-nav
|
||||
:href (app-url "events" entry-path)
|
||||
:name (get entry "name")
|
||||
:date-str date-str
|
||||
@@ -61,7 +61,7 @@
|
||||
|
||||
;; Infinite scroll sentinel
|
||||
(when (and has-more (not (empty? purl)))
|
||||
(~htmx-sentinel
|
||||
(~shared:misc/htmx-sentinel
|
||||
:id (str "entries-load-sentinel-" pg)
|
||||
:hx-get (str purl "?page=" (+ pg 1))
|
||||
:hx-trigger "intersect once"
|
||||
@@ -74,7 +74,7 @@
|
||||
(is-selected (if (not (empty? cur-cal))
|
||||
(= (get cal "slug") cur-cal)
|
||||
false)))
|
||||
(~calendar-link-nav
|
||||
(~shared:navigation/calendar-link-nav
|
||||
:href href
|
||||
:name (get cal "name")
|
||||
:nav-class nav-class
|
||||
|
||||
@@ -16,7 +16,7 @@
|
||||
:container-type "page"
|
||||
:container-id (get post "id")))
|
||||
(cal-names (join ", " (map (fn (c) (get c "name")) calendars))))
|
||||
(~link-card
|
||||
(~shared:fragments/link-card
|
||||
:title (get post "title")
|
||||
:image (get post "feature_image")
|
||||
:subtitle cal-names
|
||||
@@ -28,7 +28,7 @@
|
||||
:container-type "page"
|
||||
:container-id (get post "id")))
|
||||
(cal-names (join ", " (map (fn (c) (get c "name")) calendars))))
|
||||
(~link-card
|
||||
(~shared:fragments/link-card
|
||||
:title (get post "title")
|
||||
:image (get post "feature_image")
|
||||
:subtitle cal-names
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
;; Events header components
|
||||
|
||||
(defcomp ~events-calendars-label ()
|
||||
(defcomp ~header/calendars-label ()
|
||||
(<> (i :class "fa fa-calendar" :aria-hidden "true") (div "Calendars")))
|
||||
|
||||
(defcomp ~events-markets-label ()
|
||||
(defcomp ~header/markets-label ()
|
||||
(<> (i :class "fa fa-shopping-bag" :aria-hidden "true") (div "Markets")))
|
||||
|
||||
(defcomp ~events-calendar-label (&key name description)
|
||||
(defcomp ~header/calendar-label (&key name description)
|
||||
(div :class "flex flex-col md:flex-row md:gap-2 items-center min-w-0"
|
||||
(div :class "flex flex-row items-center gap-2"
|
||||
(i :class "fa fa-calendar")
|
||||
@@ -15,16 +15,16 @@
|
||||
:class "text-base font-normal break-words whitespace-normal min-w-0 break-all w-full text-center block"
|
||||
description)))
|
||||
|
||||
(defcomp ~events-day-label (&key date-str)
|
||||
(defcomp ~header/day-label (&key date-str)
|
||||
(div :class "flex gap-1 items-center"
|
||||
(i :class "fa fa-calendar-day")
|
||||
(span date-str)))
|
||||
|
||||
(defcomp ~events-entry-label (&key entry-id title times)
|
||||
(defcomp ~header/entry-label (&key entry-id title times)
|
||||
(div :id (str "entry-title-" entry-id) :class "flex gap-1 items-center"
|
||||
title times))
|
||||
|
||||
(defcomp ~events-slot-label (&key name description)
|
||||
(defcomp ~header/slot-label (&key name description)
|
||||
(div :class "flex flex-col md:flex-row md:gap-2 items-center"
|
||||
(div :class "flex flex-row items-center gap-2"
|
||||
(i :class "fa fa-clock")
|
||||
|
||||
@@ -11,20 +11,20 @@
|
||||
(let ((__cal (events-calendar-ctx))
|
||||
(__sc (select-colours)))
|
||||
(when (get __cal "slug")
|
||||
(~menu-row-sx :id "calendar-row" :level 3
|
||||
(~shared:layout/menu-row-sx :id "calendar-row" :level 3
|
||||
:link-href (url-for "calendar.get"
|
||||
:calendar-slug (get __cal "slug"))
|
||||
:link-label-content (~events-calendar-label
|
||||
:link-label-content (~header/calendar-label
|
||||
:name (get __cal "name")
|
||||
:description (get __cal "description"))
|
||||
:nav (<>
|
||||
(~nav-link :href (url-for "defpage_slots_listing"
|
||||
(~shared:layout/nav-link :href (url-for "defpage_slots_listing"
|
||||
:calendar-slug (get __cal "slug"))
|
||||
:icon "fa fa-clock" :label "Slots"
|
||||
:select-colours __sc)
|
||||
(let ((__rights (app-rights)))
|
||||
(when (get __rights "admin")
|
||||
(~nav-link :href (url-for "defpage_calendar_admin"
|
||||
(~shared:layout/nav-link :href (url-for "defpage_calendar_admin"
|
||||
:calendar-slug (get __cal "slug"))
|
||||
:icon "fa fa-cog"
|
||||
:select-colours __sc))))
|
||||
@@ -37,13 +37,13 @@
|
||||
(let ((__cal (events-calendar-ctx))
|
||||
(__sc (select-colours)))
|
||||
(when (get __cal "slug")
|
||||
(~menu-row-sx :id "calendar-admin-row" :level 4
|
||||
(~shared:layout/menu-row-sx :id "calendar-admin-row" :level 4
|
||||
:link-label "admin" :icon "fa fa-cog"
|
||||
:nav (<>
|
||||
(~nav-link :href (url-for "defpage_slots_listing"
|
||||
(~shared:layout/nav-link :href (url-for "defpage_slots_listing"
|
||||
:calendar-slug (get __cal "slug"))
|
||||
:label "slots" :select-colours __sc)
|
||||
(~nav-link :href (url-for "calendar.admin.calendar_description_edit"
|
||||
(~shared:layout/nav-link :href (url-for "calendar.admin.calendar_description_edit"
|
||||
:calendar-slug (get __cal "slug"))
|
||||
:label "description" :select-colours __sc))
|
||||
:child-id "calendar-admin-header-child"
|
||||
@@ -55,13 +55,13 @@
|
||||
(let ((__day (events-day-ctx))
|
||||
(__cal (events-calendar-ctx)))
|
||||
(when (get __day "date-str")
|
||||
(~menu-row-sx :id "day-row" :level 4
|
||||
(~shared:layout/menu-row-sx :id "day-row" :level 4
|
||||
:link-href (url-for "calendar.day.show_day"
|
||||
:calendar-slug (get __cal "slug")
|
||||
:year (get __day "year")
|
||||
:month (get __day "month")
|
||||
:day (get __day "day"))
|
||||
:link-label-content (~events-day-label
|
||||
:link-label-content (~header/day-label
|
||||
:date-str (get __day "date-str"))
|
||||
:nav (get __day "nav")
|
||||
:child-id "day-header-child"
|
||||
@@ -73,7 +73,7 @@
|
||||
(let ((__day (events-day-ctx))
|
||||
(__cal (events-calendar-ctx)))
|
||||
(when (get __day "date-str")
|
||||
(~menu-row-sx :id "day-admin-row" :level 5
|
||||
(~shared:layout/menu-row-sx :id "day-admin-row" :level 5
|
||||
:link-href (url-for "defpage_day_admin"
|
||||
:calendar-slug (get __cal "slug")
|
||||
:year (get __day "year")
|
||||
@@ -88,12 +88,12 @@
|
||||
(quasiquote
|
||||
(let ((__ectx (events-entry-ctx)))
|
||||
(when (get __ectx "id")
|
||||
(~menu-row-sx :id "entry-row" :level 5
|
||||
(~shared:layout/menu-row-sx :id "entry-row" :level 5
|
||||
:link-href (get __ectx "link-href")
|
||||
:link-label-content (~events-entry-label
|
||||
:link-label-content (~header/entry-label
|
||||
:entry-id (get __ectx "id")
|
||||
:title (~events-entry-title :name (get __ectx "name"))
|
||||
:times (~events-entry-times :time-str (get __ectx "time-str")))
|
||||
:title (~admin/entry-title :name (get __ectx "name"))
|
||||
:times (~admin/entry-times :time-str (get __ectx "time-str")))
|
||||
:nav (get __ectx "nav")
|
||||
:child-id "entry-header-child"
|
||||
:oob (unquote oob))))))
|
||||
@@ -103,11 +103,11 @@
|
||||
(quasiquote
|
||||
(let ((__ectx (events-entry-ctx)))
|
||||
(when (get __ectx "id")
|
||||
(~menu-row-sx :id "entry-admin-row" :level 6
|
||||
(~shared:layout/menu-row-sx :id "entry-admin-row" :level 6
|
||||
:link-href (get __ectx "admin-href")
|
||||
:link-label "admin" :icon "fa fa-cog"
|
||||
:nav (when (get __ectx "is-admin")
|
||||
(~nav-link :href (get __ectx "ticket-types-href")
|
||||
(~shared:layout/nav-link :href (get __ectx "ticket-types-href")
|
||||
:label "ticket_types"
|
||||
:select-colours (get __ectx "select-colours")))
|
||||
:child-id "entry-admin-header-child"
|
||||
@@ -118,8 +118,8 @@
|
||||
(quasiquote
|
||||
(let ((__slot (events-slot-ctx)))
|
||||
(when (get __slot "name")
|
||||
(~menu-row-sx :id "slot-row" :level 5
|
||||
:link-label-content (~events-slot-label
|
||||
(~shared:layout/menu-row-sx :id "slot-row" :level 5
|
||||
:link-label-content (~header/slot-label
|
||||
:name (get __slot "name")
|
||||
:description (get __slot "description"))
|
||||
:child-id "slot-header-child"
|
||||
@@ -131,12 +131,12 @@
|
||||
(let ((__ectx (events-entry-ctx))
|
||||
(__cal (events-calendar-ctx)))
|
||||
(when (get __ectx "id")
|
||||
(~menu-row-sx :id "ticket_types-row" :level 7
|
||||
(~shared:layout/menu-row-sx :id "ticket_types-row" :level 7
|
||||
:link-href (get __ectx "ticket-types-href")
|
||||
:link-label-content (<>
|
||||
(i :class "fa fa-ticket")
|
||||
(div :class "shrink-0" "ticket types"))
|
||||
:nav (~events-admin-placeholder-nav)
|
||||
:nav (~forms/admin-placeholder-nav)
|
||||
:child-id "ticket_type-header-child"
|
||||
:oob (unquote oob))))))
|
||||
|
||||
@@ -145,22 +145,22 @@
|
||||
(quasiquote
|
||||
(let ((__tt (events-ticket-type-ctx)))
|
||||
(when (get __tt "id")
|
||||
(~menu-row-sx :id "ticket_type-row" :level 8
|
||||
(~shared:layout/menu-row-sx :id "ticket_type-row" :level 8
|
||||
:link-href (get __tt "link-href")
|
||||
:link-label-content (div :class "flex flex-col md:flex-row md:gap-2 items-center"
|
||||
(div :class "flex flex-row items-center gap-2"
|
||||
(i :class "fa fa-ticket")
|
||||
(div :class "shrink-0" (get __tt "name"))))
|
||||
:nav (~events-admin-placeholder-nav)
|
||||
:nav (~forms/admin-placeholder-nav)
|
||||
:child-id "ticket_type-header-child-inner"
|
||||
:oob (unquote oob))))))
|
||||
|
||||
(defmacro ~events-markets-header-auto (oob)
|
||||
"Markets section header row."
|
||||
(quasiquote
|
||||
(~menu-row-sx :id "markets-row" :level 3
|
||||
(~shared:layout/menu-row-sx :id "markets-row" :level 3
|
||||
:link-href (url-for "defpage_events_markets")
|
||||
:link-label-content (~events-markets-label)
|
||||
:link-label-content (~header/markets-label)
|
||||
:child-id "markets-header-child"
|
||||
:oob (unquote oob))))
|
||||
|
||||
@@ -168,218 +168,218 @@
|
||||
;; OOB clear helpers — clear deeper header rows not present at this level
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-clear-oob-cal-admin ()
|
||||
(defcomp ~layouts/clear-oob-cal-admin ()
|
||||
"Clear OOB divs for cal-admin level (keeps down to calendar-admin)."
|
||||
(<>
|
||||
(~clear-oob-div :id "entry-admin-row")
|
||||
(~clear-oob-div :id "entry-admin-header-child")
|
||||
(~clear-oob-div :id "entry-row")
|
||||
(~clear-oob-div :id "entry-header-child")
|
||||
(~clear-oob-div :id "day-admin-row")
|
||||
(~clear-oob-div :id "day-admin-header-child")
|
||||
(~clear-oob-div :id "day-row")
|
||||
(~clear-oob-div :id "day-header-child")
|
||||
(~clear-oob-div :id "calendars-row")
|
||||
(~clear-oob-div :id "calendars-header-child")))
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-row")
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "entry-row")
|
||||
(~shared:layout/clear-oob-div :id "entry-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-admin-row")
|
||||
(~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-row")
|
||||
(~shared:layout/clear-oob-div :id "day-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendars-row")
|
||||
(~shared:layout/clear-oob-div :id "calendars-header-child")))
|
||||
|
||||
(defcomp ~events-clear-oob-slot ()
|
||||
(defcomp ~layouts/clear-oob-slot ()
|
||||
"Clear OOB divs for slot level."
|
||||
(<>
|
||||
(~clear-oob-div :id "entry-admin-row")
|
||||
(~clear-oob-div :id "entry-admin-header-child")
|
||||
(~clear-oob-div :id "entry-row")
|
||||
(~clear-oob-div :id "entry-header-child")
|
||||
(~clear-oob-div :id "day-admin-row")
|
||||
(~clear-oob-div :id "day-admin-header-child")
|
||||
(~clear-oob-div :id "day-row")
|
||||
(~clear-oob-div :id "day-header-child")
|
||||
(~clear-oob-div :id "calendars-row")
|
||||
(~clear-oob-div :id "calendars-header-child")))
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-row")
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "entry-row")
|
||||
(~shared:layout/clear-oob-div :id "entry-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-admin-row")
|
||||
(~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-row")
|
||||
(~shared:layout/clear-oob-div :id "day-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendars-row")
|
||||
(~shared:layout/clear-oob-div :id "calendars-header-child")))
|
||||
|
||||
(defcomp ~events-clear-oob-day-admin ()
|
||||
(defcomp ~layouts/clear-oob-day-admin ()
|
||||
"Clear OOB divs for day-admin level."
|
||||
(<>
|
||||
(~clear-oob-div :id "entry-admin-row")
|
||||
(~clear-oob-div :id "entry-admin-header-child")
|
||||
(~clear-oob-div :id "entry-row")
|
||||
(~clear-oob-div :id "entry-header-child")
|
||||
(~clear-oob-div :id "calendars-row")
|
||||
(~clear-oob-div :id "calendars-header-child")))
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-row")
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "entry-row")
|
||||
(~shared:layout/clear-oob-div :id "entry-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendars-row")
|
||||
(~shared:layout/clear-oob-div :id "calendars-header-child")))
|
||||
|
||||
(defcomp ~events-clear-oob-entry ()
|
||||
(defcomp ~layouts/clear-oob-entry ()
|
||||
"Clear OOB divs for entry level (public, no admin rows)."
|
||||
(<>
|
||||
(~clear-oob-div :id "entry-admin-row")
|
||||
(~clear-oob-div :id "entry-admin-header-child")
|
||||
(~clear-oob-div :id "day-admin-row")
|
||||
(~clear-oob-div :id "day-admin-header-child")
|
||||
(~clear-oob-div :id "calendar-admin-row")
|
||||
(~clear-oob-div :id "calendar-admin-header-child")
|
||||
(~clear-oob-div :id "calendars-row")
|
||||
(~clear-oob-div :id "calendars-header-child")
|
||||
(~clear-oob-div :id "post-admin-row")
|
||||
(~clear-oob-div :id "post-admin-header-child")))
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-row")
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-admin-row")
|
||||
(~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendar-admin-row")
|
||||
(~shared:layout/clear-oob-div :id "calendar-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendars-row")
|
||||
(~shared:layout/clear-oob-div :id "calendars-header-child")
|
||||
(~shared:layout/clear-oob-div :id "post-admin-row")
|
||||
(~shared:layout/clear-oob-div :id "post-admin-header-child")))
|
||||
|
||||
(defcomp ~events-clear-oob-entry-admin ()
|
||||
(defcomp ~layouts/clear-oob-entry-admin ()
|
||||
"Clear OOB divs for entry-admin level."
|
||||
(<>
|
||||
(~clear-oob-div :id "calendars-row")
|
||||
(~clear-oob-div :id "calendars-header-child")))
|
||||
(~shared:layout/clear-oob-div :id "calendars-row")
|
||||
(~shared:layout/clear-oob-div :id "calendars-header-child")))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; OOB clear helpers for renders.py — clear all deeper IDs except kept ones
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-clear-deeper-post ()
|
||||
(defcomp ~layouts/clear-deeper-post ()
|
||||
"Clear all events IDs deeper than post level."
|
||||
(<>
|
||||
(~clear-oob-div :id "entry-admin-row") (~clear-oob-div :id "entry-admin-header-child")
|
||||
(~clear-oob-div :id "entry-row") (~clear-oob-div :id "entry-header-child")
|
||||
(~clear-oob-div :id "day-admin-row") (~clear-oob-div :id "day-admin-header-child")
|
||||
(~clear-oob-div :id "day-row") (~clear-oob-div :id "day-header-child")
|
||||
(~clear-oob-div :id "calendar-admin-row") (~clear-oob-div :id "calendar-admin-header-child")
|
||||
(~clear-oob-div :id "calendar-row") (~clear-oob-div :id "calendar-header-child")
|
||||
(~clear-oob-div :id "calendars-row") (~clear-oob-div :id "calendars-header-child")
|
||||
(~clear-oob-div :id "post-admin-row") (~clear-oob-div :id "post-admin-header-child")))
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-row") (~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "entry-row") (~shared:layout/clear-oob-div :id "entry-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-admin-row") (~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-row") (~shared:layout/clear-oob-div :id "day-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendar-admin-row") (~shared:layout/clear-oob-div :id "calendar-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendar-row") (~shared:layout/clear-oob-div :id "calendar-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendars-row") (~shared:layout/clear-oob-div :id "calendars-header-child")
|
||||
(~shared:layout/clear-oob-div :id "post-admin-row") (~shared:layout/clear-oob-div :id "post-admin-header-child")))
|
||||
|
||||
(defcomp ~events-clear-deeper-post-admin ()
|
||||
(defcomp ~layouts/clear-deeper-post-admin ()
|
||||
"Clear all events IDs deeper than post-admin level."
|
||||
(<>
|
||||
(~clear-oob-div :id "entry-admin-row") (~clear-oob-div :id "entry-admin-header-child")
|
||||
(~clear-oob-div :id "entry-row") (~clear-oob-div :id "entry-header-child")
|
||||
(~clear-oob-div :id "day-admin-row") (~clear-oob-div :id "day-admin-header-child")
|
||||
(~clear-oob-div :id "day-row") (~clear-oob-div :id "day-header-child")
|
||||
(~clear-oob-div :id "calendar-admin-row") (~clear-oob-div :id "calendar-admin-header-child")
|
||||
(~clear-oob-div :id "calendar-row") (~clear-oob-div :id "calendar-header-child")
|
||||
(~clear-oob-div :id "calendars-row") (~clear-oob-div :id "calendars-header-child")))
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-row") (~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "entry-row") (~shared:layout/clear-oob-div :id "entry-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-admin-row") (~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-row") (~shared:layout/clear-oob-div :id "day-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendar-admin-row") (~shared:layout/clear-oob-div :id "calendar-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendar-row") (~shared:layout/clear-oob-div :id "calendar-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendars-row") (~shared:layout/clear-oob-div :id "calendars-header-child")))
|
||||
|
||||
(defcomp ~events-clear-deeper-calendar ()
|
||||
(defcomp ~layouts/clear-deeper-calendar ()
|
||||
"Clear all events IDs deeper than calendar level."
|
||||
(<>
|
||||
(~clear-oob-div :id "entry-admin-row") (~clear-oob-div :id "entry-admin-header-child")
|
||||
(~clear-oob-div :id "entry-row") (~clear-oob-div :id "entry-header-child")
|
||||
(~clear-oob-div :id "day-admin-row") (~clear-oob-div :id "day-admin-header-child")
|
||||
(~clear-oob-div :id "day-row") (~clear-oob-div :id "day-header-child")
|
||||
(~clear-oob-div :id "calendar-admin-row") (~clear-oob-div :id "calendar-admin-header-child")
|
||||
(~clear-oob-div :id "calendars-row") (~clear-oob-div :id "calendars-header-child")
|
||||
(~clear-oob-div :id "post-admin-row") (~clear-oob-div :id "post-admin-header-child")))
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-row") (~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "entry-row") (~shared:layout/clear-oob-div :id "entry-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-admin-row") (~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-row") (~shared:layout/clear-oob-div :id "day-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendar-admin-row") (~shared:layout/clear-oob-div :id "calendar-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendars-row") (~shared:layout/clear-oob-div :id "calendars-header-child")
|
||||
(~shared:layout/clear-oob-div :id "post-admin-row") (~shared:layout/clear-oob-div :id "post-admin-header-child")))
|
||||
|
||||
(defcomp ~events-clear-deeper-day ()
|
||||
(defcomp ~layouts/clear-deeper-day ()
|
||||
"Clear all events IDs deeper than day level."
|
||||
(<>
|
||||
(~clear-oob-div :id "entry-admin-row") (~clear-oob-div :id "entry-admin-header-child")
|
||||
(~clear-oob-div :id "entry-row") (~clear-oob-div :id "entry-header-child")
|
||||
(~clear-oob-div :id "day-admin-row") (~clear-oob-div :id "day-admin-header-child")
|
||||
(~clear-oob-div :id "calendar-admin-row") (~clear-oob-div :id "calendar-admin-header-child")
|
||||
(~clear-oob-div :id "calendars-row") (~clear-oob-div :id "calendars-header-child")
|
||||
(~clear-oob-div :id "post-admin-row") (~clear-oob-div :id "post-admin-header-child")))
|
||||
(~shared:layout/clear-oob-div :id "entry-admin-row") (~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "entry-row") (~shared:layout/clear-oob-div :id "entry-header-child")
|
||||
(~shared:layout/clear-oob-div :id "day-admin-row") (~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendar-admin-row") (~shared:layout/clear-oob-div :id "calendar-admin-header-child")
|
||||
(~shared:layout/clear-oob-div :id "calendars-row") (~shared:layout/clear-oob-div :id "calendars-header-child")
|
||||
(~shared:layout/clear-oob-div :id "post-admin-row") (~shared:layout/clear-oob-div :id "post-admin-header-child")))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Calendar admin layout: root + post + child(post-admin + cal + cal-admin)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-cal-admin-layout-full ()
|
||||
(defcomp ~layouts/cal-admin-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (<> (~post-header-auto nil)
|
||||
(~post-admin-header-auto nil "calendars")
|
||||
(~events-calendar-header-auto nil)
|
||||
(~events-calendar-admin-header-auto nil)))))
|
||||
|
||||
(defcomp ~events-cal-admin-layout-oob ()
|
||||
(defcomp ~layouts/cal-admin-layout-oob ()
|
||||
(<> (~post-admin-header-auto true "calendars")
|
||||
(~events-calendar-header-auto true)
|
||||
(~oob-header-sx :parent-id "calendar-header-child"
|
||||
(~shared:layout/oob-header-sx :parent-id "calendar-header-child"
|
||||
:row (~events-calendar-admin-header-auto nil))
|
||||
(~events-clear-oob-cal-admin)
|
||||
(~layouts/clear-oob-cal-admin)
|
||||
(~root-header-auto true)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Slots layout: same full as cal-admin
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-slots-layout-full ()
|
||||
(defcomp ~layouts/slots-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (<> (~post-header-auto nil)
|
||||
(~post-admin-header-auto nil "calendars")
|
||||
(~events-calendar-header-auto nil)
|
||||
(~events-calendar-admin-header-auto nil)))))
|
||||
|
||||
(defcomp ~events-slots-layout-oob ()
|
||||
(defcomp ~layouts/slots-layout-oob ()
|
||||
(<> (~post-admin-header-auto true "calendars")
|
||||
(~events-calendar-admin-header-auto true)
|
||||
(~events-clear-oob-cal-admin)
|
||||
(~layouts/clear-oob-cal-admin)
|
||||
(~root-header-auto true)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Slot detail layout: root + post + child(admin + cal + cal-admin + slot)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-slot-layout-full ()
|
||||
(defcomp ~layouts/slot-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (<> (~post-header-auto nil)
|
||||
(~post-admin-header-auto nil "calendars")
|
||||
(~events-calendar-header-auto nil)
|
||||
(~events-calendar-admin-header-auto nil)
|
||||
(~events-slot-header-auto nil)))))
|
||||
|
||||
(defcomp ~events-slot-layout-oob ()
|
||||
(defcomp ~layouts/slot-layout-oob ()
|
||||
(<> (~post-admin-header-auto true "calendars")
|
||||
(~events-calendar-admin-header-auto true)
|
||||
(~oob-header-sx :parent-id "calendar-admin-header-child"
|
||||
(~shared:layout/oob-header-sx :parent-id "calendar-admin-header-child"
|
||||
:row (~events-slot-header-auto nil))
|
||||
(~events-clear-oob-slot)
|
||||
(~layouts/clear-oob-slot)
|
||||
(~root-header-auto true)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Day admin layout: root + post + child(admin + cal + day + day-admin)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-day-admin-layout-full ()
|
||||
(defcomp ~layouts/day-admin-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (<> (~post-header-auto nil)
|
||||
(~post-admin-header-auto nil "calendars")
|
||||
(~events-calendar-header-auto nil)
|
||||
(~events-day-header-auto nil)
|
||||
(~events-day-admin-header-auto nil)))))
|
||||
|
||||
(defcomp ~events-day-admin-layout-oob ()
|
||||
(defcomp ~layouts/day-admin-layout-oob ()
|
||||
(<> (~post-admin-header-auto true "calendars")
|
||||
(~events-calendar-header-auto true)
|
||||
(~oob-header-sx :parent-id "day-header-child"
|
||||
(~shared:layout/oob-header-sx :parent-id "day-header-child"
|
||||
:row (~events-day-admin-header-auto nil))
|
||||
(~events-clear-oob-day-admin)
|
||||
(~layouts/clear-oob-day-admin)
|
||||
(~root-header-auto true)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Entry layout: root + child(post + cal + day + entry) — public, no admin
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-entry-layout-full ()
|
||||
(defcomp ~layouts/entry-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (<> (~post-header-auto nil)
|
||||
(~events-calendar-header-auto nil)
|
||||
(~events-day-header-auto nil)
|
||||
(~events-entry-header-auto nil)))))
|
||||
|
||||
(defcomp ~events-entry-layout-oob ()
|
||||
(defcomp ~layouts/entry-layout-oob ()
|
||||
(<> (~events-day-header-auto true)
|
||||
(~oob-header-sx :parent-id "day-header-child"
|
||||
(~shared:layout/oob-header-sx :parent-id "day-header-child"
|
||||
:row (~events-entry-header-auto nil))
|
||||
(~events-clear-oob-entry)
|
||||
(~layouts/clear-oob-entry)
|
||||
(~root-header-auto true)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Entry admin layout: root + post + child(admin + cal + day + entry + entry-admin)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-entry-admin-layout-full ()
|
||||
(defcomp ~layouts/entry-admin-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (<> (~post-header-auto nil)
|
||||
(~post-admin-header-auto nil "calendars")
|
||||
(~events-calendar-header-auto nil)
|
||||
@@ -387,21 +387,21 @@
|
||||
(~events-entry-header-auto nil)
|
||||
(~events-entry-admin-header-auto nil)))))
|
||||
|
||||
(defcomp ~events-entry-admin-layout-oob ()
|
||||
(defcomp ~layouts/entry-admin-layout-oob ()
|
||||
(<> (~post-admin-header-auto true "calendars")
|
||||
(~events-entry-header-auto true)
|
||||
(~oob-header-sx :parent-id "entry-header-child"
|
||||
(~shared:layout/oob-header-sx :parent-id "entry-header-child"
|
||||
:row (~events-entry-admin-header-auto nil))
|
||||
(~events-clear-oob-entry-admin)
|
||||
(~layouts/clear-oob-entry-admin)
|
||||
(~root-header-auto true)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Ticket types layout: root + child(post + cal + day + entry + entry-admin + ticket-types)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-ticket-types-layout-full ()
|
||||
(defcomp ~layouts/ticket-types-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (<> (~post-header-auto nil)
|
||||
(~events-calendar-header-auto nil)
|
||||
(~events-day-header-auto nil)
|
||||
@@ -409,9 +409,9 @@
|
||||
(~events-entry-admin-header-auto nil)
|
||||
(~events-ticket-types-header-auto nil)))))
|
||||
|
||||
(defcomp ~events-ticket-types-layout-oob ()
|
||||
(defcomp ~layouts/ticket-types-layout-oob ()
|
||||
(<> (~events-entry-admin-header-auto true)
|
||||
(~oob-header-sx :parent-id "entry-admin-header-child"
|
||||
(~shared:layout/oob-header-sx :parent-id "entry-admin-header-child"
|
||||
:row (~events-ticket-types-header-auto nil))
|
||||
(~root-header-auto true)))
|
||||
|
||||
@@ -419,9 +419,9 @@
|
||||
;; Ticket type layout: all headers down to ticket-type
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-ticket-type-layout-full ()
|
||||
(defcomp ~layouts/ticket-type-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (<> (~post-header-auto nil)
|
||||
(~events-calendar-header-auto nil)
|
||||
(~events-day-header-auto nil)
|
||||
@@ -430,9 +430,9 @@
|
||||
(~events-ticket-types-header-auto nil)
|
||||
(~events-ticket-type-header-auto nil)))))
|
||||
|
||||
(defcomp ~events-ticket-type-layout-oob ()
|
||||
(defcomp ~layouts/ticket-type-layout-oob ()
|
||||
(<> (~events-ticket-types-header-auto true)
|
||||
(~oob-header-sx :parent-id "ticket_types-header-child"
|
||||
(~shared:layout/oob-header-sx :parent-id "ticket_types-header-child"
|
||||
:row (~events-ticket-type-header-auto nil))
|
||||
(~root-header-auto true)))
|
||||
|
||||
@@ -440,14 +440,14 @@
|
||||
;; Markets layout: root + child(post + markets)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~events-markets-layout-full ()
|
||||
(defcomp ~layouts/markets-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (<> (~post-header-auto nil)
|
||||
(~events-markets-header-auto nil)))))
|
||||
|
||||
(defcomp ~events-markets-layout-oob ()
|
||||
(defcomp ~layouts/markets-layout-oob ()
|
||||
(<> (~post-header-auto true)
|
||||
(~oob-header-sx :parent-id "post-header-child"
|
||||
(~shared:layout/oob-header-sx :parent-id "post-header-child"
|
||||
:row (~events-markets-header-auto nil))
|
||||
(~root-header-auto true)))
|
||||
|
||||
@@ -1,15 +1,15 @@
|
||||
;; Events page-level components (slots, ticket types, buy form, cart, posts nav)
|
||||
|
||||
(defcomp ~events-slot-days-pills (&key days-inner)
|
||||
(defcomp ~page/slot-days-pills (&key days-inner)
|
||||
(div :class "flex flex-wrap gap-1" days-inner))
|
||||
|
||||
(defcomp ~events-slot-day-pill (&key day)
|
||||
(defcomp ~page/slot-day-pill (&key day)
|
||||
(span :class "px-2 py-0.5 rounded-full text-xs bg-slate-200" day))
|
||||
|
||||
(defcomp ~events-slot-no-days ()
|
||||
(defcomp ~page/slot-no-days ()
|
||||
(span :class "text-xs text-slate-400" "No days"))
|
||||
|
||||
(defcomp ~events-slot-panel (&key slot-id list-container days flexible time-str cost-str pre-action edit-url)
|
||||
(defcomp ~page/slot-panel (&key slot-id list-container days flexible time-str cost-str pre-action edit-url)
|
||||
(section :id (str "slot-" slot-id) :class list-container
|
||||
(div :class "flex flex-col"
|
||||
(div :class "text-xs font-semibold uppercase tracking-wide text-stone-500" "Days")
|
||||
@@ -27,15 +27,15 @@
|
||||
(button :type "button" :class pre-action :sx-get edit-url
|
||||
:sx-target (str "#slot-" slot-id) :sx-swap "outerHTML" "Edit")))
|
||||
|
||||
(defcomp ~events-slot-description-oob (&key description)
|
||||
(defcomp ~page/slot-description-oob (&key description)
|
||||
(div :id "slot-description-title" :sx-swap-oob "outerHTML"
|
||||
:class "text-base font-normal break-words whitespace-normal min-w-0 break-all w-full text-center block"
|
||||
description))
|
||||
|
||||
(defcomp ~events-slots-empty-row ()
|
||||
(defcomp ~page/slots-empty-row ()
|
||||
(tr (td :colspan "5" :class "p-3 text-stone-500" "No slots yet.")))
|
||||
|
||||
(defcomp ~events-slots-row (&key tr-cls slot-href pill-cls hx-select slot-name description
|
||||
(defcomp ~page/slots-row (&key tr-cls slot-href pill-cls hx-select slot-name description
|
||||
flexible days time-str cost-str action-btn del-url csrf-hdr)
|
||||
(tr :class tr-cls
|
||||
(td :class "p-2 align-top w-1/6"
|
||||
@@ -57,7 +57,7 @@
|
||||
:sx-swap "outerHTML" :sx-headers csrf-hdr :sx-trigger "confirmed"
|
||||
(i :class "fa-solid fa-trash")))))
|
||||
|
||||
(defcomp ~events-slots-table (&key list-container rows pre-action add-url)
|
||||
(defcomp ~page/slots-table (&key list-container rows pre-action add-url)
|
||||
(section :id "slots-table" :class list-container
|
||||
(table :class "w-full text-sm border table-fixed"
|
||||
(thead :class "bg-stone-100"
|
||||
@@ -78,61 +78,61 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Days pills from data — replaces Python loop
|
||||
(defcomp ~events-days-pills-from-data (&key days)
|
||||
(defcomp ~page/days-pills-from-data (&key days)
|
||||
(if (empty? (or days (list)))
|
||||
(~events-slot-no-days)
|
||||
(~events-slot-days-pills
|
||||
:days-inner (<> (map (lambda (d) (~events-slot-day-pill :day d)) days)))))
|
||||
(~page/slot-no-days)
|
||||
(~page/slot-days-pills
|
||||
:days-inner (<> (map (lambda (d) (~page/slot-day-pill :day d)) days)))))
|
||||
|
||||
;; Slot panel from data
|
||||
(defcomp ~events-slot-panel-from-data (&key slot-id list-container days
|
||||
(defcomp ~page/slot-panel-from-data (&key slot-id list-container days
|
||||
flexible time-str cost-str
|
||||
pre-action edit-url description oob)
|
||||
(<>
|
||||
(~events-slot-panel
|
||||
(~page/slot-panel
|
||||
:slot-id slot-id :list-container list-container
|
||||
:days (~events-days-pills-from-data :days days)
|
||||
:days (~page/days-pills-from-data :days days)
|
||||
:flexible flexible :time-str time-str :cost-str cost-str
|
||||
:pre-action pre-action :edit-url edit-url)
|
||||
(when oob
|
||||
(~events-slot-description-oob :description (or description "")))))
|
||||
(~page/slot-description-oob :description (or description "")))))
|
||||
|
||||
;; Slots table from data
|
||||
(defcomp ~events-slots-table-from-data (&key list-container slots pre-action add-url
|
||||
(defcomp ~page/slots-table-from-data (&key list-container slots pre-action add-url
|
||||
tr-cls pill-cls action-btn hx-select csrf-hdr)
|
||||
(~events-slots-table
|
||||
(~page/slots-table
|
||||
:list-container list-container
|
||||
:rows (if (empty? (or slots (list)))
|
||||
(~events-slots-empty-row)
|
||||
(~page/slots-empty-row)
|
||||
(<> (map (lambda (s)
|
||||
(~events-slots-row
|
||||
(~page/slots-row
|
||||
:tr-cls tr-cls :slot-href (get s "slot-href")
|
||||
:pill-cls pill-cls :hx-select hx-select
|
||||
:slot-name (get s "slot-name") :description (get s "description")
|
||||
:flexible (get s "flexible")
|
||||
:days (~events-days-pills-from-data :days (get s "days"))
|
||||
:days (~page/days-pills-from-data :days (get s "days"))
|
||||
:time-str (get s "time-str")
|
||||
:cost-str (get s "cost-str") :action-btn action-btn
|
||||
:del-url (get s "del-url") :csrf-hdr csrf-hdr))
|
||||
(or slots (list)))))
|
||||
:pre-action pre-action :add-url add-url))
|
||||
|
||||
(defcomp ~events-ticket-type-col (&key label value)
|
||||
(defcomp ~page/ticket-type-col (&key label value)
|
||||
(div :class "flex flex-col"
|
||||
(div :class "text-xs font-semibold uppercase tracking-wide text-stone-500" label)
|
||||
(div :class "mt-1" value)))
|
||||
|
||||
(defcomp ~events-ticket-type-panel (&key ticket-id list-container c1 c2 c3 pre-action edit-url)
|
||||
(defcomp ~page/ticket-type-panel (&key ticket-id list-container c1 c2 c3 pre-action edit-url)
|
||||
(section :id (str "ticket-" ticket-id) :class list-container
|
||||
(div :class "grid grid-cols-1 sm:grid-cols-3 gap-4 text-sm"
|
||||
c1 c2 c3)
|
||||
(button :type "button" :class pre-action :sx-get edit-url
|
||||
:sx-target (str "#ticket-" ticket-id) :sx-swap "outerHTML" "Edit")))
|
||||
|
||||
(defcomp ~events-ticket-types-empty-row ()
|
||||
(defcomp ~page/ticket-types-empty-row ()
|
||||
(tr (td :colspan "4" :class "p-3 text-stone-500" "No ticket types yet.")))
|
||||
|
||||
(defcomp ~events-ticket-types-row (&key tr-cls tt-href pill-cls hx-select tt-name cost-str count
|
||||
(defcomp ~page/ticket-types-row (&key tr-cls tt-href pill-cls hx-select tt-name cost-str count
|
||||
action-btn del-url csrf-hdr)
|
||||
(tr :class tr-cls
|
||||
(td :class "p-2 align-top w-1/3"
|
||||
@@ -151,7 +151,7 @@
|
||||
:sx-swap "outerHTML" :sx-headers csrf-hdr :sx-trigger "confirmed"
|
||||
(i :class "fa-solid fa-trash")))))
|
||||
|
||||
(defcomp ~events-ticket-types-table (&key list-container rows action-btn add-url)
|
||||
(defcomp ~page/ticket-types-table (&key list-container rows action-btn add-url)
|
||||
(section :id "tickets-table" :class list-container
|
||||
(table :class "w-full text-sm border table-fixed"
|
||||
(thead :class "bg-stone-100"
|
||||
@@ -164,7 +164,7 @@
|
||||
(button :class action-btn :sx-get add-url :sx-target "#ticket-add-container" :sx-swap "innerHTML"
|
||||
(i :class "fa fa-plus") " Add ticket type"))))
|
||||
|
||||
(defcomp ~events-ticket-config-display (&key price-str count-str show-js)
|
||||
(defcomp ~page/ticket-config-display (&key price-str count-str show-js)
|
||||
(div :class "space-y-2"
|
||||
(div :class "flex items-center gap-2"
|
||||
(span :class "text-sm font-medium text-stone-700" "Price:")
|
||||
@@ -175,13 +175,13 @@
|
||||
(button :type "button" :class "text-xs text-blue-600 hover:text-blue-800 underline"
|
||||
:onclick show-js "Edit ticket config")))
|
||||
|
||||
(defcomp ~events-ticket-config-none (&key show-js)
|
||||
(defcomp ~page/ticket-config-none (&key show-js)
|
||||
(div :class "space-y-2"
|
||||
(span :class "text-sm text-stone-400" "No tickets configured")
|
||||
(button :type "button" :class "block text-xs text-blue-600 hover:text-blue-800 underline"
|
||||
:onclick show-js "Configure tickets")))
|
||||
|
||||
(defcomp ~events-ticket-config-form (&key entry-id hidden-cls update-url csrf price-val count-val hide-js)
|
||||
(defcomp ~page/ticket-config-form (&key entry-id hidden-cls update-url csrf price-val count-val hide-js)
|
||||
(form :id (str "ticket-form-" entry-id) :class (str hidden-cls " space-y-3 mt-2 p-3 border rounded bg-stone-50")
|
||||
:sx-post update-url :sx-target (str "#entry-tickets-" entry-id) :sx-swap "innerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
@@ -203,12 +203,12 @@
|
||||
:onclick hide-js "Cancel"))))
|
||||
|
||||
;; Data-driven buy form — Python passes pre-resolved data, .sx does layout + iteration
|
||||
(defcomp ~events-buy-form (&key entry-id info-sold info-remaining info-basket
|
||||
(defcomp ~page/buy-form (&key entry-id info-sold info-remaining info-basket
|
||||
ticket-types user-ticket-counts-by-type
|
||||
user-ticket-count price-str adjust-url csrf state
|
||||
my-tickets-href)
|
||||
(if (!= state "confirmed")
|
||||
(~events-buy-not-confirmed :entry-id (str entry-id))
|
||||
(~page/buy-not-confirmed :entry-id (str entry-id))
|
||||
(let ((eid-s (str entry-id))
|
||||
(target (str "#ticket-buy-" entry-id)))
|
||||
(div :id (str "ticket-buy-" entry-id) :class "rounded-xl border border-stone-200 bg-white p-4"
|
||||
@@ -234,19 +234,19 @@
|
||||
(div :class "flex items-center justify-between p-3 rounded-lg bg-stone-50 border border-stone-100"
|
||||
(div (div :class "font-medium text-sm" (get tt "name"))
|
||||
(div :class "text-xs text-stone-500" (get tt "cost_str")))
|
||||
(~events-adjust-inline :csrf csrf :adjust-url adjust-url :target target
|
||||
(~page/adjust-inline :csrf csrf :adjust-url adjust-url :target target
|
||||
:entry-id eid-s :count tt-count :ticket-type-id tt-id
|
||||
:my-tickets-href my-tickets-href))))
|
||||
ticket-types))
|
||||
(<> (div :class "flex items-center justify-between mb-4"
|
||||
(div (span :class "font-medium text-green-600" price-str)
|
||||
(span :class "text-sm text-stone-500 ml-2" "per ticket")))
|
||||
(~events-adjust-inline :csrf csrf :adjust-url adjust-url :target target
|
||||
(~page/adjust-inline :csrf csrf :adjust-url adjust-url :target target
|
||||
:entry-id eid-s :count (if user-ticket-count user-ticket-count 0)
|
||||
:ticket-type-id nil :my-tickets-href my-tickets-href)))))))
|
||||
|
||||
;; Inline +/- controls (used by both default and per-type)
|
||||
(defcomp ~events-adjust-inline (&key csrf adjust-url target entry-id count ticket-type-id my-tickets-href)
|
||||
(defcomp ~page/adjust-inline (&key csrf adjust-url target entry-id count ticket-type-id my-tickets-href)
|
||||
(if (= count 0)
|
||||
(form :sx-post adjust-url :sx-target target :sx-swap "outerHTML" :class "flex items-center"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
@@ -279,13 +279,13 @@
|
||||
:class "inline-flex items-center justify-center w-8 h-8 text-sm font-medium rounded-full border border-emerald-600 text-emerald-700 hover:bg-emerald-50 text-xl"
|
||||
"+")))))
|
||||
|
||||
(defcomp ~events-buy-not-confirmed (&key entry-id)
|
||||
(defcomp ~page/buy-not-confirmed (&key entry-id)
|
||||
(div :id (str "ticket-buy-" entry-id) :class "rounded-xl border border-stone-200 bg-stone-50 p-4 text-sm text-stone-500"
|
||||
(i :class "fa fa-ticket mr-1" :aria-hidden "true")
|
||||
"Tickets available once this event is confirmed."))
|
||||
|
||||
|
||||
(defcomp ~events-buy-result (&key entry-id tickets remaining my-tickets-href)
|
||||
(defcomp ~page/buy-result (&key entry-id tickets remaining my-tickets-href)
|
||||
(let ((count (len tickets))
|
||||
(suffix (if (= count 1) "" "s")))
|
||||
(div :id (str "ticket-buy-" entry-id) :class "rounded-xl border border-emerald-200 bg-emerald-50 p-4"
|
||||
@@ -308,21 +308,21 @@
|
||||
"View all my tickets")))))
|
||||
|
||||
;; Single response wrappers for POST routes (include OOB cart icon)
|
||||
(defcomp ~events-buy-response (&key entry-id tickets remaining my-tickets-href
|
||||
(defcomp ~page/buy-response (&key entry-id tickets remaining my-tickets-href
|
||||
cart-count blog-href cart-href logo)
|
||||
(<>
|
||||
(~events-cart-icon :cart-count cart-count :blog-href blog-href :cart-href cart-href :logo logo)
|
||||
(~events-buy-result :entry-id entry-id :tickets tickets :remaining remaining
|
||||
(~page/cart-icon :cart-count cart-count :blog-href blog-href :cart-href cart-href :logo logo)
|
||||
(~page/buy-result :entry-id entry-id :tickets tickets :remaining remaining
|
||||
:my-tickets-href my-tickets-href)))
|
||||
|
||||
(defcomp ~events-adjust-response (&key cart-count blog-href cart-href logo
|
||||
(defcomp ~page/adjust-response (&key cart-count blog-href cart-href logo
|
||||
entry-id info-sold info-remaining info-basket
|
||||
ticket-types user-ticket-counts-by-type
|
||||
user-ticket-count price-str adjust-url csrf state
|
||||
my-tickets-href)
|
||||
(<>
|
||||
(~events-cart-icon :cart-count cart-count :blog-href blog-href :cart-href cart-href :logo logo)
|
||||
(~events-buy-form :entry-id entry-id :info-sold info-sold :info-remaining info-remaining
|
||||
(~page/cart-icon :cart-count cart-count :blog-href blog-href :cart-href cart-href :logo logo)
|
||||
(~page/buy-form :entry-id entry-id :info-sold info-sold :info-remaining info-remaining
|
||||
:info-basket info-basket :ticket-types ticket-types
|
||||
:user-ticket-counts-by-type user-ticket-counts-by-type
|
||||
:user-ticket-count user-ticket-count :price-str price-str
|
||||
@@ -330,18 +330,18 @@
|
||||
:my-tickets-href my-tickets-href)))
|
||||
|
||||
;; Unified OOB cart icon — picks logo or badge based on count
|
||||
(defcomp ~events-cart-icon (&key cart-count blog-href cart-href logo)
|
||||
(defcomp ~page/cart-icon (&key cart-count blog-href cart-href logo)
|
||||
(if (= cart-count 0)
|
||||
(~events-cart-icon-logo :blog-href blog-href :logo logo)
|
||||
(~events-cart-icon-badge :cart-href cart-href :count (str cart-count))))
|
||||
(~page/cart-icon-logo :blog-href blog-href :logo logo)
|
||||
(~page/cart-icon-badge :cart-href cart-href :count (str cart-count))))
|
||||
|
||||
(defcomp ~events-cart-icon-logo (&key blog-href logo)
|
||||
(defcomp ~page/cart-icon-logo (&key blog-href logo)
|
||||
(div :id "cart-mini" :sx-swap-oob "true"
|
||||
(div :class "h-12 w-12 rounded-full overflow-hidden border border-stone-300 flex-shrink-0"
|
||||
(a :href blog-href :class "h-full w-full font-bold text-5xl flex-shrink-0 flex flex-row items-center gap-1"
|
||||
(img :src logo :class "h-full w-full rounded-full object-cover border border-stone-300 flex-shrink-0")))))
|
||||
|
||||
(defcomp ~events-cart-icon-badge (&key cart-href count)
|
||||
(defcomp ~page/cart-icon-badge (&key cart-href count)
|
||||
(div :id "cart-mini" :sx-swap-oob "true"
|
||||
(a :href cart-href :class "relative inline-flex items-center justify-center text-stone-700 hover:text-emerald-700"
|
||||
(i :class "fa fa-shopping-cart text-5xl" :aria-hidden "true")
|
||||
@@ -349,37 +349,37 @@
|
||||
count))))
|
||||
|
||||
;; Inline ticket widget (for all-events/page-summary cards)
|
||||
(defcomp ~events-tw-form (&key ticket-url target csrf entry-id count-val btn)
|
||||
(defcomp ~page/tw-form (&key ticket-url target csrf entry-id count-val btn)
|
||||
(form :action ticket-url :method "post" :sx-post ticket-url :sx-target target :sx-swap "outerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(input :type "hidden" :name "entry_id" :value entry-id)
|
||||
(input :type "hidden" :name "count" :value count-val)
|
||||
btn))
|
||||
|
||||
(defcomp ~events-tw-cart-plus ()
|
||||
(defcomp ~page/tw-cart-plus ()
|
||||
(button :type "submit" :class "relative inline-flex items-center justify-center text-stone-500 hover:bg-emerald-50 rounded p-1"
|
||||
(i :class "fa fa-cart-plus text-2xl" :aria-hidden "true")))
|
||||
|
||||
(defcomp ~events-tw-minus ()
|
||||
(defcomp ~page/tw-minus ()
|
||||
(button :type "submit" :class "inline-flex items-center justify-center w-8 h-8 text-sm font-medium rounded-full border border-emerald-600 text-emerald-700 hover:bg-emerald-50 text-xl" "-"))
|
||||
|
||||
(defcomp ~events-tw-plus ()
|
||||
(defcomp ~page/tw-plus ()
|
||||
(button :type "submit" :class "inline-flex items-center justify-center w-8 h-8 text-sm font-medium rounded-full border border-emerald-600 text-emerald-700 hover:bg-emerald-50 text-xl" "+"))
|
||||
|
||||
(defcomp ~events-tw-cart-icon (&key qty)
|
||||
(defcomp ~page/tw-cart-icon (&key qty)
|
||||
(span :class "relative inline-flex items-center justify-center text-emerald-700"
|
||||
(span :class "relative inline-flex items-center justify-center"
|
||||
(i :class "fa-solid fa-shopping-cart text-xl" :aria-hidden "true")
|
||||
(span :class "absolute top-1/2 left-1/2 -translate-x-1/2 -translate-y-1/2 pointer-events-none"
|
||||
(span :class "flex items-center justify-center bg-black text-white rounded-full w-4 h-4 text-xs font-bold" qty)))))
|
||||
|
||||
(defcomp ~events-tw-widget (&key entry-id price inner)
|
||||
(defcomp ~page/tw-widget (&key entry-id price inner)
|
||||
(div :id (str "page-ticket-" entry-id) :class "flex items-center gap-2"
|
||||
(span :class "text-green-600 font-medium text-sm" price)
|
||||
inner))
|
||||
|
||||
;; Entry posts panel
|
||||
(defcomp ~events-entry-posts-panel (&key posts search-url entry-id)
|
||||
(defcomp ~page/entry-posts-panel (&key posts search-url entry-id)
|
||||
(div :class "space-y-2"
|
||||
posts
|
||||
(div :class "mt-3 pt-3 border-t"
|
||||
@@ -390,13 +390,13 @@
|
||||
:sx-target (str "#post-search-results-" entry-id) :sx-swap "innerHTML" :name "q")
|
||||
(div :id (str "post-search-results-" entry-id) :class "mt-2 max-h-96 overflow-y-auto border rounded"))))
|
||||
|
||||
(defcomp ~events-entry-posts-list (&key items)
|
||||
(defcomp ~page/entry-posts-list (&key items)
|
||||
(div :class "space-y-2" items))
|
||||
|
||||
(defcomp ~events-entry-posts-none ()
|
||||
(defcomp ~page/entry-posts-none ()
|
||||
(p :class "text-sm text-stone-400" "No posts associated"))
|
||||
|
||||
(defcomp ~events-entry-post-item (&key img title del-url entry-id csrf-hdr)
|
||||
(defcomp ~page/entry-post-item (&key img title del-url entry-id csrf-hdr)
|
||||
(div :class "flex items-center justify-between gap-3 p-2 bg-stone-50 rounded border"
|
||||
img (span :class "text-sm flex-1" title)
|
||||
(button :type "button" :class "text-xs text-red-600 hover:text-red-800 flex-shrink-0"
|
||||
@@ -409,41 +409,41 @@
|
||||
:sx-headers csrf-hdr
|
||||
(i :class "fa fa-times") " Remove")))
|
||||
|
||||
(defcomp ~events-post-img (&key src alt)
|
||||
(defcomp ~page/post-img (&key src alt)
|
||||
(img :src src :alt alt :class "w-8 h-8 rounded-full object-cover flex-shrink-0"))
|
||||
|
||||
(defcomp ~events-post-img-placeholder ()
|
||||
(defcomp ~page/post-img-placeholder ()
|
||||
(div :class "w-8 h-8 rounded-full bg-stone-200 flex-shrink-0"))
|
||||
|
||||
;; Entry posts nav OOB
|
||||
(defcomp ~events-entry-posts-nav-oob-empty ()
|
||||
(defcomp ~page/entry-posts-nav-oob-empty ()
|
||||
(div :id "entry-posts-nav-wrapper" :sx-swap-oob "true"))
|
||||
|
||||
(defcomp ~events-entry-posts-nav-oob (&key items)
|
||||
(defcomp ~page/entry-posts-nav-oob (&key items)
|
||||
(div :class "flex flex-col sm:flex-row sm:items-center gap-2 border-r border-stone-200 mr-2 sm:max-w-2xl"
|
||||
:id "entry-posts-nav-wrapper" :sx-swap-oob "true"
|
||||
(div :class "flex overflow-x-auto gap-1 scrollbar-thin" items)))
|
||||
|
||||
(defcomp ~events-entry-nav-post (&key href nav-btn img title)
|
||||
(defcomp ~page/entry-nav-post (&key href nav-btn img title)
|
||||
(a :href href :class nav-btn img (div :class "flex-1 min-w-0" (div :class "font-medium truncate" title))))
|
||||
|
||||
;; Post nav entries OOB
|
||||
(defcomp ~events-post-nav-oob-empty ()
|
||||
(defcomp ~page/post-nav-oob-empty ()
|
||||
(div :id "entries-calendars-nav-wrapper" :sx-swap-oob "true"))
|
||||
|
||||
(defcomp ~events-post-nav-entry (&key href nav-btn name time-str)
|
||||
(defcomp ~page/post-nav-entry (&key href nav-btn name time-str)
|
||||
(a :href href :class nav-btn
|
||||
(div :class "w-8 h-8 rounded bg-stone-200 flex-shrink-0")
|
||||
(div :class "flex-1 min-w-0"
|
||||
(div :class "font-medium truncate" name)
|
||||
(div :class "text-xs text-stone-600 truncate" time-str))))
|
||||
|
||||
(defcomp ~events-post-nav-calendar (&key href nav-btn name)
|
||||
(defcomp ~page/post-nav-calendar (&key href nav-btn name)
|
||||
(a :href href :class nav-btn
|
||||
(i :class "fa fa-calendar" :aria-hidden "true")
|
||||
(div name)))
|
||||
|
||||
(defcomp ~events-post-nav-wrapper (&key items hyperscript)
|
||||
(defcomp ~page/post-nav-wrapper (&key items hyperscript)
|
||||
(div :class "flex flex-col sm:flex-row sm:items-center gap-2 border-r border-stone-200 mr-2 sm:max-w-2xl"
|
||||
:id "entries-calendars-nav-wrapper" :sx-swap-oob "true"
|
||||
(button :class "entries-nav-arrow hidden flex-shrink-0 p-2 hover:bg-stone-200 rounded"
|
||||
@@ -461,7 +461,7 @@
|
||||
(i :class "fa fa-chevron-right"))))
|
||||
|
||||
;; Entry nav post link (with image)
|
||||
(defcomp ~events-entry-nav-post-link (&key href img title)
|
||||
(defcomp ~page/entry-nav-post-link (&key href img title)
|
||||
(a :href href :class "flex items-center gap-2 px-3 py-2 hover:bg-stone-100 rounded transition text-sm border sm:whitespace-nowrap sm:flex-shrink-0"
|
||||
img (div :class "flex-1 min-w-0" (div :class "font-medium truncate" title))))
|
||||
|
||||
@@ -471,60 +471,60 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Post image helper from data
|
||||
(defcomp ~events-post-img-from-data (&key src alt)
|
||||
(defcomp ~page/post-img-from-data (&key src alt)
|
||||
(if src
|
||||
(~events-post-img :src src :alt alt)
|
||||
(~events-post-img-placeholder)))
|
||||
(~page/post-img :src src :alt alt)
|
||||
(~page/post-img-placeholder)))
|
||||
|
||||
;; Entry posts nav OOB from data
|
||||
(defcomp ~events-entry-posts-nav-oob-from-data (&key nav-btn posts)
|
||||
(defcomp ~page/entry-posts-nav-oob-from-data (&key nav-btn posts)
|
||||
(if (empty? (or posts (list)))
|
||||
(~events-entry-posts-nav-oob-empty)
|
||||
(~events-entry-posts-nav-oob
|
||||
(~page/entry-posts-nav-oob-empty)
|
||||
(~page/entry-posts-nav-oob
|
||||
:items (<> (map (lambda (p)
|
||||
(~events-entry-nav-post
|
||||
(~page/entry-nav-post
|
||||
:href (get p "href") :nav-btn nav-btn
|
||||
:img (~events-post-img-from-data :src (get p "img") :alt (get p "title"))
|
||||
:img (~page/post-img-from-data :src (get p "img") :alt (get p "title"))
|
||||
:title (get p "title")))
|
||||
posts)))))
|
||||
|
||||
;; Entry posts nav (non-OOB) from data — for desktop nav embedding
|
||||
(defcomp ~events-entry-posts-nav-inner-from-data (&key posts)
|
||||
(defcomp ~page/entry-posts-nav-inner-from-data (&key posts)
|
||||
(when (not (empty? (or posts (list))))
|
||||
(~events-entry-posts-nav-oob
|
||||
(~page/entry-posts-nav-oob
|
||||
:items (<> (map (lambda (p)
|
||||
(~events-entry-nav-post-link
|
||||
(~page/entry-nav-post-link
|
||||
:href (get p "href")
|
||||
:img (~events-post-img-from-data :src (get p "img") :alt (get p "title"))
|
||||
:img (~page/post-img-from-data :src (get p "img") :alt (get p "title"))
|
||||
:title (get p "title")))
|
||||
posts)))))
|
||||
|
||||
;; Post nav entries+calendars OOB from data
|
||||
(defcomp ~events-post-nav-wrapper-from-data (&key nav-btn entries calendars hyperscript)
|
||||
(defcomp ~page/post-nav-wrapper-from-data (&key nav-btn entries calendars hyperscript)
|
||||
(if (and (empty? (or entries (list))) (empty? (or calendars (list))))
|
||||
(~events-post-nav-oob-empty)
|
||||
(~events-post-nav-wrapper
|
||||
(~page/post-nav-oob-empty)
|
||||
(~page/post-nav-wrapper
|
||||
:items (<>
|
||||
(map (lambda (e)
|
||||
(~events-post-nav-entry
|
||||
(~page/post-nav-entry
|
||||
:href (get e "href") :nav-btn nav-btn
|
||||
:name (get e "name") :time-str (get e "time-str")))
|
||||
(or entries (list)))
|
||||
(map (lambda (c)
|
||||
(~events-post-nav-calendar
|
||||
(~page/post-nav-calendar
|
||||
:href (get c "href") :nav-btn nav-btn :name (get c "name")))
|
||||
(or calendars (list))))
|
||||
:hyperscript hyperscript)))
|
||||
|
||||
;; Entry posts panel from data
|
||||
(defcomp ~events-entry-posts-panel-from-data (&key entry-id posts search-url)
|
||||
(~events-entry-posts-panel
|
||||
(defcomp ~page/entry-posts-panel-from-data (&key entry-id posts search-url)
|
||||
(~page/entry-posts-panel
|
||||
:posts (if (empty? (or posts (list)))
|
||||
(~events-entry-posts-none)
|
||||
(~events-entry-posts-list
|
||||
(~page/entry-posts-none)
|
||||
(~page/entry-posts-list
|
||||
:items (<> (map (lambda (p)
|
||||
(~events-entry-post-item
|
||||
:img (~events-post-img-from-data :src (get p "img") :alt (get p "title"))
|
||||
(~page/entry-post-item
|
||||
:img (~page/post-img-from-data :src (get p "img") :alt (get p "title"))
|
||||
:title (get p "title")
|
||||
:del-url (get p "del-url") :entry-id entry-id
|
||||
:csrf-hdr (get p "csrf-hdr")))
|
||||
@@ -532,11 +532,11 @@
|
||||
:search-url search-url :entry-id entry-id))
|
||||
|
||||
;; CRUD list/panel from data — shared by calendars + markets
|
||||
(defcomp ~events-crud-list-from-data (&key items empty-msg list-id)
|
||||
(defcomp ~page/crud-list-from-data (&key items empty-msg list-id)
|
||||
(if (empty? (or items (list)))
|
||||
(~empty-state :message empty-msg :cls "text-gray-500 mt-4")
|
||||
(~shared:misc/empty-state :message empty-msg :cls "text-gray-500 mt-4")
|
||||
(<> (map (lambda (item)
|
||||
(~crud-item
|
||||
(~shared:misc/crud-item
|
||||
:href (get item "href") :name (get item "name") :slug (get item "slug")
|
||||
:del-url (get item "del-url") :csrf-hdr (get item "csrf-hdr")
|
||||
:list-id list-id
|
||||
@@ -544,84 +544,84 @@
|
||||
:confirm-text (get item "confirm-text")))
|
||||
items))))
|
||||
|
||||
(defcomp ~events-crud-panel-from-data (&key can-create create-url csrf errors-id list-id
|
||||
(defcomp ~page/crud-panel-from-data (&key can-create create-url csrf errors-id list-id
|
||||
placeholder btn-label items empty-msg)
|
||||
(~crud-panel
|
||||
(~shared:misc/crud-panel
|
||||
:form (when can-create
|
||||
(~crud-create-form
|
||||
(~shared:misc/crud-create-form
|
||||
:create-url create-url :csrf csrf :errors-id errors-id
|
||||
:list-id list-id :placeholder placeholder :btn-label btn-label))
|
||||
:list (~events-crud-list-from-data :items items :empty-msg empty-msg :list-id list-id)
|
||||
:list (~page/crud-list-from-data :items items :empty-msg empty-msg :list-id list-id)
|
||||
:list-id list-id))
|
||||
|
||||
;; Post nav admin cog
|
||||
(defcomp ~events-post-nav-admin-cog (&key href aclass)
|
||||
(defcomp ~page/post-nav-admin-cog (&key href aclass)
|
||||
(div :class "relative nav-group"
|
||||
(a :href href :class aclass
|
||||
(i :class "fa fa-cog" :aria-hidden "true"))))
|
||||
|
||||
;; Post nav from data — calendar links + container nav + admin
|
||||
(defcomp ~events-post-nav-from-data (&key calendars container-nav select-colours
|
||||
(defcomp ~page/post-nav-from-data (&key calendars container-nav select-colours
|
||||
has-admin admin-href aclass)
|
||||
(<>
|
||||
(map (lambda (c)
|
||||
(~nav-link :href (get c "href") :icon "fa fa-calendar"
|
||||
(~shared:layout/nav-link :href (get c "href") :icon "fa fa-calendar"
|
||||
:label (get c "name") :select-colours select-colours
|
||||
:is-selected (get c "is-selected")))
|
||||
(or calendars (list)))
|
||||
(when container-nav container-nav)
|
||||
(when has-admin
|
||||
(~events-post-nav-admin-cog :href admin-href :aclass aclass))))
|
||||
(~page/post-nav-admin-cog :href admin-href :aclass aclass))))
|
||||
|
||||
;; Calendar nav from data — slots + admin link
|
||||
(defcomp ~events-calendar-nav-from-data (&key slots-href admin-href select-colours is-admin)
|
||||
(defcomp ~page/calendar-nav-from-data (&key slots-href admin-href select-colours is-admin)
|
||||
(<>
|
||||
(~nav-link :href slots-href :icon "fa fa-clock"
|
||||
(~shared:layout/nav-link :href slots-href :icon "fa fa-clock"
|
||||
:label "Slots" :select-colours select-colours)
|
||||
(when is-admin
|
||||
(~nav-link :href admin-href :icon "fa fa-cog"
|
||||
(~shared:layout/nav-link :href admin-href :icon "fa fa-cog"
|
||||
:select-colours select-colours))))
|
||||
|
||||
;; Calendar admin nav from data
|
||||
(defcomp ~events-calendar-admin-nav-from-data (&key links select-colours)
|
||||
(defcomp ~page/calendar-admin-nav-from-data (&key links select-colours)
|
||||
(<> (map (lambda (l)
|
||||
(~nav-link :href (get l "href") :label (get l "label")
|
||||
(~shared:layout/nav-link :href (get l "href") :label (get l "label")
|
||||
:select-colours select-colours))
|
||||
(or links (list)))))
|
||||
|
||||
;; Day nav from data — confirmed entries + admin link
|
||||
(defcomp ~events-day-nav-from-data (&key entries is-admin admin-href)
|
||||
(defcomp ~page/day-nav-from-data (&key entries is-admin admin-href)
|
||||
(<>
|
||||
(when (not (empty? (or entries (list))))
|
||||
(~events-day-entries-nav
|
||||
(~day/entries-nav
|
||||
:inner (<> (map (lambda (e)
|
||||
(~events-day-entry-link
|
||||
(~day/entry-link
|
||||
:href (get e "href") :name (get e "name") :time-str (get e "time-str")))
|
||||
entries))))
|
||||
(when is-admin
|
||||
(~nav-link :href admin-href :icon "fa fa-cog"))))
|
||||
(~shared:layout/nav-link :href admin-href :icon "fa fa-cog"))))
|
||||
|
||||
;; Post search results from data
|
||||
(defcomp ~events-post-search-results-from-data (&key items page next-url has-more)
|
||||
(defcomp ~page/post-search-results-from-data (&key items page next-url has-more)
|
||||
(<>
|
||||
(map (lambda (item)
|
||||
(~events-post-search-item
|
||||
(~forms/post-search-item
|
||||
:post-url (get item "post-url") :entry-id (get item "entry-id")
|
||||
:csrf (get item "csrf") :post-id (get item "post-id")
|
||||
:img (~events-post-img-from-data :src (get item "img") :alt (get item "title"))
|
||||
:img (~page/post-img-from-data :src (get item "img") :alt (get item "title"))
|
||||
:title (get item "title")))
|
||||
(or items (list)))
|
||||
(cond
|
||||
(has-more (~events-post-search-sentinel :page page :next-url next-url))
|
||||
((not (empty? (or items (list)))) (~events-post-search-end))
|
||||
(has-more (~forms/post-search-sentinel :page page :next-url next-url))
|
||||
((not (empty? (or items (list)))) (~forms/post-search-end))
|
||||
(true ""))))
|
||||
|
||||
;; Entry options from data — state-driven button composition
|
||||
(defcomp ~events-entry-options-from-data (&key entry-id state buttons)
|
||||
(~events-entry-options
|
||||
(defcomp ~page/entry-options-from-data (&key entry-id state buttons)
|
||||
(~admin/entry-options
|
||||
:entry-id entry-id
|
||||
:buttons (<> (map (lambda (b)
|
||||
(~events-entry-option-button
|
||||
(~admin/entry-option-button
|
||||
:url (get b "url") :target (str "#calendar_entry_options_" entry-id)
|
||||
:csrf (get b "csrf") :btn-type (get b "btn-type")
|
||||
:action-btn (get b "action-btn")
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
;; Events payments components
|
||||
|
||||
(defcomp ~events-payments-panel (&key update-url csrf merchant-code placeholder input-cls sumup-configured checkout-prefix)
|
||||
(defcomp ~payments/panel (&key update-url csrf merchant-code placeholder input-cls sumup-configured checkout-prefix)
|
||||
(section :class "p-4 max-w-lg mx-auto"
|
||||
(~sumup-settings-form :update-url update-url :csrf csrf :merchant-code merchant-code
|
||||
(~shared:misc/sumup-settings-form :update-url update-url :csrf csrf :merchant-code merchant-code
|
||||
:placeholder placeholder :input-cls input-cls :sumup-configured sumup-configured
|
||||
:checkout-prefix checkout-prefix :sx-select "#payments-panel")))
|
||||
|
||||
(defcomp ~events-markets-create-form (&key create-url csrf)
|
||||
(defcomp ~payments/markets-create-form (&key create-url csrf)
|
||||
(<>
|
||||
(div :id "market-create-errors" :class "mt-2 text-sm text-red-600")
|
||||
(form :class "mt-4 flex gap-2 items-end" :sx-post create-url
|
||||
@@ -20,15 +20,15 @@
|
||||
:placeholder "e.g. Farm Shop, Bakery"))
|
||||
(button :type "submit" :class "border rounded px-3 py-2" "Add market"))))
|
||||
|
||||
(defcomp ~events-markets-panel (&key form list)
|
||||
(defcomp ~payments/markets-panel (&key form list)
|
||||
(section :class "p-4"
|
||||
form
|
||||
(div :id "markets-list" :class "mt-6" list)))
|
||||
|
||||
(defcomp ~events-markets-empty ()
|
||||
(defcomp ~payments/markets-empty ()
|
||||
(p :class "text-gray-500 mt-4" "No markets yet. Create one above."))
|
||||
|
||||
(defcomp ~events-markets-item (&key href market-name market-slug del-url csrf-hdr)
|
||||
(defcomp ~payments/markets-item (&key href market-name market-slug del-url csrf-hdr)
|
||||
(div :class "mt-6 border rounded-lg p-4"
|
||||
(div :class "flex items-center justify-between gap-3"
|
||||
(a :class "flex items-baseline gap-3" :href href
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Events ticket components
|
||||
|
||||
(defcomp ~events-ticket-card (&key href entry-name type-name time-str cal-name badge code-prefix)
|
||||
(defcomp ~tickets/card (&key (href :as string) (entry-name :as string) (type-name :as string?) (time-str :as string?) (cal-name :as string?) badge (code-prefix :as string))
|
||||
(a :href href :class "block rounded-xl border border-stone-200 bg-white p-4 hover:shadow-md transition"
|
||||
(div :class "flex items-start justify-between gap-4"
|
||||
(div :class "flex-1 min-w-0"
|
||||
@@ -12,7 +12,7 @@
|
||||
badge
|
||||
(span :class "text-xs text-stone-400 font-mono" (str code-prefix "..."))))))
|
||||
|
||||
(defcomp ~events-tickets-panel (&key list-container has-tickets cards)
|
||||
(defcomp ~tickets/panel (&key (list-container :as string) (has-tickets :as boolean) cards)
|
||||
(section :id "tickets-list" :class list-container
|
||||
(h1 :class "text-2xl font-bold mb-6" "My Tickets")
|
||||
(if has-tickets
|
||||
@@ -22,9 +22,9 @@
|
||||
(p :class "text-lg" "No tickets yet")
|
||||
(p :class "text-sm mt-1" "Tickets will appear here after you purchase them.")))))
|
||||
|
||||
(defcomp ~events-ticket-detail (&key list-container back-href header-bg entry-name badge
|
||||
type-name code time-date time-range cal-name
|
||||
type-desc checkin-str qr-script)
|
||||
(defcomp ~tickets/detail (&key (list-container :as string) (back-href :as string) (header-bg :as string) (entry-name :as string) badge
|
||||
(type-name :as string?) (code :as string) (time-date :as string?) (time-range :as string?) (cal-name :as string?)
|
||||
(type-desc :as string?) (checkin-str :as string?) (qr-script :as string))
|
||||
(section :id "ticket-detail" :class (str list-container " max-w-lg mx-auto")
|
||||
(a :href back-href :class "inline-flex items-center gap-1 text-sm text-stone-500 hover:text-stone-700 mb-4"
|
||||
(i :class "fa fa-arrow-left" :aria-hidden "true") " Back to my tickets")
|
||||
@@ -54,25 +54,25 @@
|
||||
(script :src "https://cdn.jsdelivr.net/npm/qrcode@1.5.3/build/qrcode.min.js")
|
||||
(script qr-script)))
|
||||
|
||||
(defcomp ~events-ticket-admin-stat (&key border bg text-cls label-cls value label)
|
||||
(defcomp ~tickets/admin-stat (&key (border :as string) (bg :as string) (text-cls :as string) (label-cls :as string) (value :as string) (label :as string))
|
||||
(div :class (str "rounded-xl border " border " " bg " p-4 text-center")
|
||||
(div :class (str "text-2xl font-bold " text-cls) value)
|
||||
(div :class (str "text-xs " label-cls " uppercase tracking-wide") label)))
|
||||
|
||||
(defcomp ~events-ticket-admin-date (&key date-str)
|
||||
(defcomp ~tickets/admin-date (&key (date-str :as string))
|
||||
(div :class "text-xs text-stone-500" date-str))
|
||||
|
||||
(defcomp ~events-ticket-admin-checkin-form (&key checkin-url code csrf)
|
||||
(defcomp ~tickets/admin-checkin-form (&key (checkin-url :as string) (code :as string) (csrf :as string))
|
||||
(form :sx-post checkin-url :sx-target (str "#ticket-row-" code) :sx-swap "outerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit" :class "px-3 py-1 bg-blue-600 text-white text-xs rounded hover:bg-blue-700 transition"
|
||||
(i :class "fa fa-check mr-1" :aria-hidden "true") "Check in")))
|
||||
|
||||
(defcomp ~events-ticket-admin-checked-in (&key time-str)
|
||||
(defcomp ~tickets/admin-checked-in (&key (time-str :as string))
|
||||
(span :class "text-xs text-blue-600"
|
||||
(i :class "fa fa-check-circle" :aria-hidden "true") (str " " time-str)))
|
||||
|
||||
(defcomp ~events-ticket-admin-row (&key code code-short entry-name date type-name badge action)
|
||||
(defcomp ~tickets/admin-row (&key (code :as string) (code-short :as string) (entry-name :as string) date (type-name :as string) badge action)
|
||||
(tr :class "hover:bg-stone-50 transition" :id (str "ticket-row-" code)
|
||||
(td :class "px-4 py-3" (span :class "font-mono text-xs" code-short))
|
||||
(td :class "px-4 py-3" (div :class "font-medium" entry-name) date)
|
||||
@@ -80,7 +80,7 @@
|
||||
(td :class "px-4 py-3" badge)
|
||||
(td :class "px-4 py-3" action)))
|
||||
|
||||
(defcomp ~events-ticket-admin-panel (&key list-container stats lookup-url has-tickets rows)
|
||||
(defcomp ~tickets/admin-panel (&key (list-container :as string) stats (lookup-url :as string) (has-tickets :as boolean) rows)
|
||||
(section :id "ticket-admin" :class list-container
|
||||
(h1 :class "text-2xl font-bold mb-6" "Ticket Admin")
|
||||
(div :class "grid grid-cols-2 sm:grid-cols-4 gap-3 mb-8" stats)
|
||||
@@ -113,11 +113,11 @@
|
||||
(tbody :class "divide-y divide-stone-100" rows))
|
||||
(div :class "px-6 py-8 text-center text-stone-500" "No tickets yet"))))))
|
||||
|
||||
(defcomp ~events-checkin-error (&key message)
|
||||
(defcomp ~tickets/checkin-error (&key (message :as string))
|
||||
(div :class "rounded-lg border border-red-200 bg-red-50 p-3 text-sm text-red-800"
|
||||
(i :class "fa fa-exclamation-circle mr-2" :aria-hidden "true") message))
|
||||
|
||||
(defcomp ~events-checkin-success-row (&key code code-short entry-name date type-name badge time-str)
|
||||
(defcomp ~tickets/checkin-success-row (&key (code :as string) (code-short :as string) (entry-name :as string) date (type-name :as string) badge (time-str :as string))
|
||||
(tr :class "bg-blue-50" :id (str "ticket-row-" code)
|
||||
(td :class "px-4 py-3" (span :class "font-mono text-xs" code-short))
|
||||
(td :class "px-4 py-3" (div :class "font-medium" entry-name) date)
|
||||
@@ -127,65 +127,65 @@
|
||||
(span :class "text-xs text-blue-600"
|
||||
(i :class "fa fa-check-circle" :aria-hidden "true") (str " " time-str)))))
|
||||
|
||||
(defcomp ~events-lookup-error (&key message)
|
||||
(defcomp ~tickets/lookup-error (&key (message :as string))
|
||||
(div :class "rounded-lg border border-red-200 bg-red-50 p-4 text-sm text-red-800"
|
||||
(i :class "fa fa-exclamation-circle mr-2" :aria-hidden "true") message))
|
||||
|
||||
(defcomp ~events-lookup-info (&key entry-name)
|
||||
(defcomp ~tickets/lookup-info (&key (entry-name :as string))
|
||||
(div :class "font-semibold text-lg" entry-name))
|
||||
|
||||
(defcomp ~events-lookup-type (&key type-name)
|
||||
(defcomp ~tickets/lookup-type (&key (type-name :as string))
|
||||
(div :class "text-sm text-stone-600" type-name))
|
||||
|
||||
(defcomp ~events-lookup-date (&key date-str)
|
||||
(defcomp ~tickets/lookup-date (&key (date-str :as string))
|
||||
(div :class "text-sm text-stone-500 mt-1" date-str))
|
||||
|
||||
(defcomp ~events-lookup-cal (&key cal-name)
|
||||
(defcomp ~tickets/lookup-cal (&key (cal-name :as string))
|
||||
(div :class "text-xs text-stone-400 mt-0.5" cal-name))
|
||||
|
||||
(defcomp ~events-lookup-status (&key badge code)
|
||||
(defcomp ~tickets/lookup-status (&key badge (code :as string))
|
||||
(div :class "mt-2" badge (span :class "text-xs text-stone-400 ml-2 font-mono" code)))
|
||||
|
||||
(defcomp ~events-lookup-checkin-time (&key date-str)
|
||||
(defcomp ~tickets/lookup-checkin-time (&key (date-str :as string))
|
||||
(div :class "text-xs text-blue-600 mt-1" (str "Checked in: " date-str)))
|
||||
|
||||
(defcomp ~events-lookup-checkin-btn (&key checkin-url code csrf)
|
||||
(defcomp ~tickets/lookup-checkin-btn (&key (checkin-url :as string) (code :as string) (csrf :as string))
|
||||
(form :sx-post checkin-url :sx-target (str "#checkin-action-" code) :sx-swap "innerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit"
|
||||
:class "px-6 py-3 bg-blue-600 text-white rounded-lg hover:bg-blue-700 transition font-semibold text-lg"
|
||||
(i :class "fa fa-check mr-2" :aria-hidden "true") "Check In")))
|
||||
|
||||
(defcomp ~events-lookup-checked-in ()
|
||||
(defcomp ~tickets/lookup-checked-in ()
|
||||
(div :class "text-blue-600 text-center"
|
||||
(i :class "fa fa-check-circle text-3xl" :aria-hidden "true")
|
||||
(div :class "text-sm font-medium mt-1" "Checked In")))
|
||||
|
||||
(defcomp ~events-lookup-cancelled ()
|
||||
(defcomp ~tickets/lookup-cancelled ()
|
||||
(div :class "text-red-600 text-center"
|
||||
(i :class "fa fa-times-circle text-3xl" :aria-hidden "true")
|
||||
(div :class "text-sm font-medium mt-1" "Cancelled")))
|
||||
|
||||
(defcomp ~events-lookup-card (&key info code action)
|
||||
(defcomp ~tickets/lookup-card (&key info (code :as string) action)
|
||||
(div :class "rounded-lg border border-stone-200 bg-stone-50 p-4"
|
||||
(div :class "flex items-start justify-between gap-4"
|
||||
(div :class "flex-1" info)
|
||||
(div :id (str "checkin-action-" code) action))))
|
||||
|
||||
(defcomp ~events-entry-tickets-admin-row (&key code code-short type-name badge action)
|
||||
(defcomp ~tickets/entry-tickets-admin-row (&key (code :as string) (code-short :as string) (type-name :as string) badge action)
|
||||
(tr :class "hover:bg-stone-50" :id (str "entry-ticket-row-" code)
|
||||
(td :class "px-4 py-2 font-mono text-xs" code-short)
|
||||
(td :class "px-4 py-2" type-name)
|
||||
(td :class "px-4 py-2" badge)
|
||||
(td :class "px-4 py-2" action)))
|
||||
|
||||
(defcomp ~events-entry-tickets-admin-checkin (&key checkin-url code csrf)
|
||||
(defcomp ~tickets/entry-tickets-admin-checkin (&key (checkin-url :as string) (code :as string) (csrf :as string))
|
||||
(form :sx-post checkin-url :sx-target (str "#entry-ticket-row-" code) :sx-swap "outerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit" :class "px-3 py-1 bg-blue-600 text-white text-xs rounded hover:bg-blue-700"
|
||||
"Check in")))
|
||||
|
||||
(defcomp ~events-entry-tickets-admin-table (&key rows)
|
||||
(defcomp ~tickets/entry-tickets-admin-table (&key rows)
|
||||
(div :class "overflow-x-auto rounded-xl border border-stone-200"
|
||||
(table :class "w-full text-sm"
|
||||
(thead :class "bg-stone-50"
|
||||
@@ -195,10 +195,10 @@
|
||||
(th :class "px-4 py-2 text-left font-medium text-stone-600" "Actions")))
|
||||
(tbody :class "divide-y divide-stone-100" rows))))
|
||||
|
||||
(defcomp ~events-entry-tickets-admin-empty ()
|
||||
(defcomp ~tickets/entry-tickets-admin-empty ()
|
||||
(div :class "text-center py-6 text-stone-500 text-sm" "No tickets for this entry"))
|
||||
|
||||
(defcomp ~events-entry-tickets-admin-panel (&key entry-name count-label body)
|
||||
(defcomp ~tickets/entry-tickets-admin-panel (&key (entry-name :as string) (count-label :as string) body)
|
||||
(div :class "space-y-4"
|
||||
(div :class "flex items-center justify-between"
|
||||
(h3 :class "text-lg font-semibold" (str "Tickets for: " entry-name))
|
||||
@@ -211,72 +211,72 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; My tickets panel from data
|
||||
(defcomp ~events-tickets-panel-from-data (&key list-container tickets)
|
||||
(~events-tickets-panel
|
||||
(defcomp ~tickets/panel-from-data (&key (list-container :as string) (tickets :as list?))
|
||||
(~tickets/panel
|
||||
:list-container list-container
|
||||
:has-tickets (not (empty? (or tickets (list))))
|
||||
:cards (<> (map (lambda (t)
|
||||
(~events-ticket-card
|
||||
(~tickets/card
|
||||
:href (get t "href") :entry-name (get t "entry-name")
|
||||
:type-name (get t "type-name") :time-str (get t "time-str")
|
||||
:cal-name (get t "cal-name")
|
||||
:badge (~ticket-state-badge :state (get t "state"))
|
||||
:badge (~entries/ticket-state-badge :state (get t "state"))
|
||||
:code-prefix (get t "code-prefix")))
|
||||
(or tickets (list))))))
|
||||
|
||||
;; Ticket detail from data — uses lg badge variant
|
||||
(defcomp ~events-ticket-detail-from-data (&key list-container back-href header-bg entry-name
|
||||
state type-name code time-date time-range
|
||||
cal-name type-desc checkin-str qr-script)
|
||||
(~events-ticket-detail
|
||||
(defcomp ~tickets/detail-from-data (&key (list-container :as string) (back-href :as string) (header-bg :as string) (entry-name :as string)
|
||||
(state :as string) (type-name :as string?) (code :as string) (time-date :as string?) (time-range :as string?)
|
||||
(cal-name :as string?) (type-desc :as string?) (checkin-str :as string?) (qr-script :as string))
|
||||
(~tickets/detail
|
||||
:list-container list-container :back-href back-href
|
||||
:header-bg header-bg :entry-name entry-name
|
||||
:badge (~ticket-state-badge-lg :state state)
|
||||
:badge (~entries/ticket-state-badge-lg :state state)
|
||||
:type-name type-name :code code
|
||||
:time-date time-date :time-range time-range
|
||||
:cal-name cal-name :type-desc type-desc
|
||||
:checkin-str checkin-str :qr-script qr-script))
|
||||
|
||||
;; Ticket admin row from data — conditional action column
|
||||
(defcomp ~events-ticket-admin-row-from-data (&key code code-short entry-name date-str
|
||||
type-name state checkin-url csrf
|
||||
checked-in-time)
|
||||
(~events-ticket-admin-row
|
||||
(defcomp ~tickets/admin-row-from-data (&key (code :as string) (code-short :as string) (entry-name :as string) (date-str :as string?)
|
||||
(type-name :as string) (state :as string) (checkin-url :as string) (csrf :as string)
|
||||
(checked-in-time :as string?))
|
||||
(~tickets/admin-row
|
||||
:code code :code-short code-short
|
||||
:entry-name entry-name
|
||||
:date (when date-str (~events-ticket-admin-date :date-str date-str))
|
||||
:date (when date-str (~tickets/admin-date :date-str date-str))
|
||||
:type-name type-name
|
||||
:badge (~ticket-state-badge :state state)
|
||||
:badge (~entries/ticket-state-badge :state state)
|
||||
:action (cond
|
||||
((or (= state "confirmed") (= state "reserved"))
|
||||
(~events-ticket-admin-checkin-form
|
||||
(~tickets/admin-checkin-form
|
||||
:checkin-url checkin-url :code code :csrf csrf))
|
||||
((= state "checked_in")
|
||||
(~events-ticket-admin-checked-in :time-str (or checked-in-time "")))
|
||||
(~tickets/admin-checked-in :time-str (or checked-in-time "")))
|
||||
(true nil))))
|
||||
|
||||
;; Ticket admin panel from data
|
||||
(defcomp ~events-ticket-admin-panel-from-data (&key list-container lookup-url tickets
|
||||
total confirmed checked-in reserved)
|
||||
(~events-ticket-admin-panel
|
||||
(defcomp ~tickets/admin-panel-from-data (&key (list-container :as string) (lookup-url :as string) (tickets :as list?)
|
||||
(total :as number?) (confirmed :as number?) (checked-in :as number?) (reserved :as number?))
|
||||
(~tickets/admin-panel
|
||||
:list-container list-container
|
||||
:stats (<>
|
||||
(~events-ticket-admin-stat :border "border-stone-200" :bg ""
|
||||
(~tickets/admin-stat :border "border-stone-200" :bg ""
|
||||
:text-cls "text-stone-900" :label-cls "text-stone-500"
|
||||
:value (str (or total 0)) :label "Total")
|
||||
(~events-ticket-admin-stat :border "border-emerald-200" :bg "bg-emerald-50"
|
||||
(~tickets/admin-stat :border "border-emerald-200" :bg "bg-emerald-50"
|
||||
:text-cls "text-emerald-700" :label-cls "text-emerald-600"
|
||||
:value (str (or confirmed 0)) :label "Confirmed")
|
||||
(~events-ticket-admin-stat :border "border-blue-200" :bg "bg-blue-50"
|
||||
(~tickets/admin-stat :border "border-blue-200" :bg "bg-blue-50"
|
||||
:text-cls "text-blue-700" :label-cls "text-blue-600"
|
||||
:value (str (or checked-in 0)) :label "Checked In")
|
||||
(~events-ticket-admin-stat :border "border-amber-200" :bg "bg-amber-50"
|
||||
(~tickets/admin-stat :border "border-amber-200" :bg "bg-amber-50"
|
||||
:text-cls "text-amber-700" :label-cls "text-amber-600"
|
||||
:value (str (or reserved 0)) :label "Reserved"))
|
||||
:lookup-url lookup-url
|
||||
:has-tickets (not (empty? (or tickets (list))))
|
||||
:rows (<> (map (lambda (t)
|
||||
(~events-ticket-admin-row-from-data
|
||||
(~tickets/admin-row-from-data
|
||||
:code (get t "code") :code-short (get t "code-short")
|
||||
:entry-name (get t "entry-name") :date-str (get t "date-str")
|
||||
:type-name (get t "type-name") :state (get t "state")
|
||||
@@ -285,45 +285,45 @@
|
||||
(or tickets (list))))))
|
||||
|
||||
;; Entry tickets admin from data
|
||||
(defcomp ~events-entry-tickets-admin-from-data (&key entry-name count-label tickets csrf)
|
||||
(~events-entry-tickets-admin-panel
|
||||
(defcomp ~tickets/entry-tickets-admin-from-data (&key (entry-name :as string) (count-label :as string) (tickets :as list?) (csrf :as string))
|
||||
(~tickets/entry-tickets-admin-panel
|
||||
:entry-name entry-name :count-label count-label
|
||||
:body (if (empty? (or tickets (list)))
|
||||
(~events-entry-tickets-admin-empty)
|
||||
(~events-entry-tickets-admin-table
|
||||
(~tickets/entry-tickets-admin-empty)
|
||||
(~tickets/entry-tickets-admin-table
|
||||
:rows (<> (map (lambda (t)
|
||||
(~events-entry-tickets-admin-row
|
||||
(~tickets/entry-tickets-admin-row
|
||||
:code (get t "code") :code-short (get t "code-short")
|
||||
:type-name (get t "type-name")
|
||||
:badge (~ticket-state-badge :state (get t "state"))
|
||||
:badge (~entries/ticket-state-badge :state (get t "state"))
|
||||
:action (cond
|
||||
((or (= (get t "state") "confirmed") (= (get t "state") "reserved"))
|
||||
(~events-entry-tickets-admin-checkin
|
||||
(~tickets/entry-tickets-admin-checkin
|
||||
:checkin-url (get t "checkin-url") :code (get t "code") :csrf csrf))
|
||||
((= (get t "state") "checked_in")
|
||||
(~events-ticket-admin-checked-in :time-str (or (get t "checked-in-time") "")))
|
||||
(~tickets/admin-checked-in :time-str (or (get t "checked-in-time") "")))
|
||||
(true nil))))
|
||||
(or tickets (list))))))))
|
||||
|
||||
;; Checkin success row from data
|
||||
(defcomp ~events-checkin-success-row-from-data (&key code code-short entry-name date-str type-name time-str)
|
||||
(~events-checkin-success-row
|
||||
(defcomp ~tickets/checkin-success-row-from-data (&key (code :as string) (code-short :as string) (entry-name :as string) (date-str :as string?) (type-name :as string) (time-str :as string))
|
||||
(~tickets/checkin-success-row
|
||||
:code code :code-short code-short
|
||||
:entry-name entry-name
|
||||
:date (when date-str (~events-ticket-admin-date :date-str date-str))
|
||||
:date (when date-str (~tickets/admin-date :date-str date-str))
|
||||
:type-name type-name
|
||||
:badge (~ticket-state-badge :state "checked_in")
|
||||
:badge (~entries/ticket-state-badge :state "checked_in")
|
||||
:time-str time-str))
|
||||
|
||||
;; Ticket types table from data
|
||||
(defcomp ~events-ticket-types-table-from-data (&key list-container ticket-types action-btn add-url
|
||||
tr-cls pill-cls hx-select csrf-hdr)
|
||||
(~events-ticket-types-table
|
||||
(defcomp ~tickets/types-table-from-data (&key (list-container :as string) (ticket-types :as list?) (action-btn :as string) (add-url :as string)
|
||||
(tr-cls :as string) (pill-cls :as string) (hx-select :as string) (csrf-hdr :as string))
|
||||
(~page/ticket-types-table
|
||||
:list-container list-container
|
||||
:rows (if (empty? (or ticket-types (list)))
|
||||
(~events-ticket-types-empty-row)
|
||||
(~page/ticket-types-empty-row)
|
||||
(<> (map (lambda (tt)
|
||||
(~events-ticket-types-row
|
||||
(~page/ticket-types-row
|
||||
:tr-cls tr-cls :tt-href (get tt "tt-href")
|
||||
:pill-cls pill-cls :hx-select hx-select
|
||||
:tt-name (get tt "tt-name") :cost-str (get tt "cost-str")
|
||||
@@ -333,23 +333,23 @@
|
||||
:action-btn action-btn :add-url add-url))
|
||||
|
||||
;; Lookup result from data
|
||||
(defcomp ~events-lookup-result-from-data (&key entry-name type-name date-str cal-name
|
||||
state code checked-in-str
|
||||
checkin-url csrf)
|
||||
(~events-lookup-card
|
||||
(defcomp ~tickets/lookup-result-from-data (&key (entry-name :as string) (type-name :as string?) (date-str :as string?) (cal-name :as string?)
|
||||
(state :as string) (code :as string) (checked-in-str :as string?)
|
||||
(checkin-url :as string) (csrf :as string))
|
||||
(~tickets/lookup-card
|
||||
:info (<>
|
||||
(~events-lookup-info :entry-name entry-name)
|
||||
(when type-name (~events-lookup-type :type-name type-name))
|
||||
(when date-str (~events-lookup-date :date-str date-str))
|
||||
(when cal-name (~events-lookup-cal :cal-name cal-name))
|
||||
(~events-lookup-status
|
||||
:badge (~ticket-state-badge :state state) :code code)
|
||||
(~tickets/lookup-info :entry-name entry-name)
|
||||
(when type-name (~tickets/lookup-type :type-name type-name))
|
||||
(when date-str (~tickets/lookup-date :date-str date-str))
|
||||
(when cal-name (~tickets/lookup-cal :cal-name cal-name))
|
||||
(~tickets/lookup-status
|
||||
:badge (~entries/ticket-state-badge :state state) :code code)
|
||||
(when checked-in-str
|
||||
(~events-lookup-checkin-time :date-str checked-in-str)))
|
||||
(~tickets/lookup-checkin-time :date-str checked-in-str)))
|
||||
:code code
|
||||
:action (cond
|
||||
((or (= state "confirmed") (= state "reserved"))
|
||||
(~events-lookup-checkin-btn :checkin-url checkin-url :code code :csrf csrf))
|
||||
((= state "checked_in") (~events-lookup-checked-in))
|
||||
((= state "cancelled") (~events-lookup-cancelled))
|
||||
(~tickets/lookup-checkin-btn :checkin-url checkin-url :code code :csrf csrf))
|
||||
((= state "checked_in") (~tickets/lookup-checked-in))
|
||||
((= state "cancelled") (~tickets/lookup-cancelled))
|
||||
(true nil))))
|
||||
|
||||
@@ -7,8 +7,8 @@
|
||||
:auth :admin
|
||||
:layout :events-calendar-admin
|
||||
:data (calendar-admin-data calendar-slug)
|
||||
:content (~events-calendar-admin-panel
|
||||
:description-content (~events-calendar-description-display
|
||||
:content (~admin/calendar-admin-panel
|
||||
:description-content (~calendar/description-display
|
||||
:description cal-description :edit-url desc-edit-url)
|
||||
:csrf csrf :description cal-description))
|
||||
|
||||
@@ -18,7 +18,7 @@
|
||||
:auth :admin
|
||||
:layout :events-day-admin
|
||||
:data (day-admin-data calendar-slug year month day)
|
||||
:content (~events-day-admin-panel))
|
||||
:content (~day/admin-panel))
|
||||
|
||||
;; Slots listing
|
||||
(defpage slots-listing
|
||||
@@ -26,25 +26,25 @@
|
||||
:auth :public
|
||||
:layout :events-slots
|
||||
:data (slots-data calendar-slug)
|
||||
:content (~events-slots-table
|
||||
:content (~page/slots-table
|
||||
:list-container list-container
|
||||
:rows (if has-slots
|
||||
(<> (map (fn (s)
|
||||
(~events-slots-row
|
||||
(~page/slots-row
|
||||
:tr-cls tr-cls :slot-href (get s "slot-href")
|
||||
:pill-cls pill-cls :hx-select hx-select
|
||||
:slot-name (get s "name") :description (get s "description")
|
||||
:flexible (get s "flexible")
|
||||
:days (if (get s "has-days")
|
||||
(~events-slot-days-pills :days-inner
|
||||
(<> (map (fn (d) (~events-slot-day-pill :day d)) (get s "day-list"))))
|
||||
(~events-slot-no-days))
|
||||
(~page/slot-days-pills :days-inner
|
||||
(<> (map (fn (d) (~page/slot-day-pill :day d)) (get s "day-list"))))
|
||||
(~page/slot-no-days))
|
||||
:time-str (get s "time-str")
|
||||
:cost-str (get s "cost-str") :action-btn action-btn
|
||||
:del-url (get s "del-url")
|
||||
:csrf-hdr csrf-hdr))
|
||||
slots-list))
|
||||
(~events-slots-empty-row))
|
||||
(~page/slots-empty-row))
|
||||
:pre-action pre-action :add-url add-url))
|
||||
|
||||
;; Slot detail
|
||||
@@ -53,13 +53,13 @@
|
||||
:auth :admin
|
||||
:layout :events-slot
|
||||
:data (slot-data calendar-slug slot-id)
|
||||
:content (~events-slot-panel
|
||||
:content (~page/slot-panel
|
||||
:slot-id slot-id-str
|
||||
:list-container list-container
|
||||
:days (if has-days
|
||||
(~events-slot-days-pills :days-inner
|
||||
(<> (map (fn (d) (~events-slot-day-pill :day d)) day-list)))
|
||||
(~events-slot-no-days))
|
||||
(~page/slot-days-pills :days-inner
|
||||
(<> (map (fn (d) (~page/slot-day-pill :day d)) day-list)))
|
||||
(~page/slot-no-days))
|
||||
:flexible flexible
|
||||
:time-str time-str :cost-str cost-str
|
||||
:pre-action pre-action :edit-url edit-url))
|
||||
@@ -70,29 +70,29 @@
|
||||
:auth :admin
|
||||
:layout :events-entry
|
||||
:data (entry-data calendar-slug entry-id)
|
||||
:content (~events-entry-panel
|
||||
:content (~admin/entry-panel
|
||||
:entry-id entry-id-str :list-container list-container
|
||||
:name (~events-entry-field :label "Name"
|
||||
:content (~events-entry-name-field :name entry-name))
|
||||
:slot (~events-entry-field :label "Slot"
|
||||
:name (~admin/entry-field :label "Name"
|
||||
:content (~admin/entry-name-field :name entry-name))
|
||||
:slot (~admin/entry-field :label "Slot"
|
||||
:content (if has-slot
|
||||
(~events-entry-slot-assigned :slot-name slot-name :flex-label flex-label)
|
||||
(~events-entry-slot-none)))
|
||||
:time (~events-entry-field :label "Time Period"
|
||||
:content (~events-entry-time-field :time-str time-str))
|
||||
:state (~events-entry-field :label "State"
|
||||
:content (~events-entry-state-field :entry-id entry-id-str
|
||||
:badge (~badge :cls state-badge-cls :label state-badge-label)))
|
||||
:cost (~events-entry-field :label "Cost"
|
||||
:content (~events-entry-cost-field :cost cost-str))
|
||||
:tickets (~events-entry-field :label "Tickets"
|
||||
:content (~events-entry-tickets-field :entry-id entry-id-str
|
||||
(~admin/entry-slot-assigned :slot-name slot-name :flex-label flex-label)
|
||||
(~admin/entry-slot-none)))
|
||||
:time (~admin/entry-field :label "Time Period"
|
||||
:content (~admin/entry-time-field :time-str time-str))
|
||||
:state (~admin/entry-field :label "State"
|
||||
:content (~admin/entry-state-field :entry-id entry-id-str
|
||||
:badge (~shared:misc/badge :cls state-badge-cls :label state-badge-label)))
|
||||
:cost (~admin/entry-field :label "Cost"
|
||||
:content (~admin/entry-cost-field :cost cost-str))
|
||||
:tickets (~admin/entry-field :label "Tickets"
|
||||
:content (~admin/entry-tickets-field :entry-id entry-id-str
|
||||
:tickets-config tickets-config))
|
||||
:buy buy-form
|
||||
:date (~events-entry-field :label "Date"
|
||||
:content (~events-entry-date-field :date-str date-str))
|
||||
:posts (~events-entry-field :label "Associated Posts"
|
||||
:content (~events-entry-posts-field :entry-id entry-id-str
|
||||
:date (~admin/entry-field :label "Date"
|
||||
:content (~admin/entry-date-field :date-str date-str))
|
||||
:posts (~admin/entry-field :label "Associated Posts"
|
||||
:content (~admin/entry-posts-field :entry-id entry-id-str
|
||||
:posts-panel posts-panel))
|
||||
:options options-html
|
||||
:pre-action pre-action :edit-url edit-url)
|
||||
@@ -104,9 +104,9 @@
|
||||
:auth :admin
|
||||
:layout :events-entry-admin
|
||||
:data (entry-admin-data calendar-slug entry-id year month day)
|
||||
:content (~nav-link :href ticket-types-href :label "ticket_types"
|
||||
:content (~shared:layout/nav-link :href ticket-types-href :label "ticket_types"
|
||||
:select-colours select-colours :aclass nav-btn :is-selected false)
|
||||
:menu (~events-admin-placeholder-nav))
|
||||
:menu (~forms/admin-placeholder-nav))
|
||||
|
||||
;; Ticket types listing
|
||||
(defpage ticket-types-listing
|
||||
@@ -114,11 +114,11 @@
|
||||
:auth :public
|
||||
:layout :events-ticket-types
|
||||
:data (ticket-types-data calendar-slug entry-id year month day)
|
||||
:content (~events-ticket-types-table
|
||||
:content (~page/ticket-types-table
|
||||
:list-container list-container
|
||||
:rows (if has-types
|
||||
(<> (map (fn (tt)
|
||||
(~events-ticket-types-row
|
||||
(~page/ticket-types-row
|
||||
:tr-cls tr-cls :tt-href (get tt "tt-href")
|
||||
:pill-cls pill-cls :hx-select hx-select
|
||||
:tt-name (get tt "tt-name") :cost-str (get tt "cost-str")
|
||||
@@ -126,9 +126,9 @@
|
||||
:del-url (get tt "del-url")
|
||||
:csrf-hdr csrf-hdr))
|
||||
types-list))
|
||||
(~events-ticket-types-empty-row))
|
||||
(~page/ticket-types-empty-row))
|
||||
:action-btn action-btn :add-url add-url)
|
||||
:menu (~events-admin-placeholder-nav))
|
||||
:menu (~forms/admin-placeholder-nav))
|
||||
|
||||
;; Ticket type detail
|
||||
(defpage ticket-type-detail
|
||||
@@ -136,13 +136,13 @@
|
||||
:auth :admin
|
||||
:layout :events-ticket-type
|
||||
:data (ticket-type-data calendar-slug entry-id ticket-type-id year month day)
|
||||
:content (~events-ticket-type-panel
|
||||
:content (~page/ticket-type-panel
|
||||
:ticket-id ticket-id :list-container list-container
|
||||
:c1 (~events-ticket-type-col :label "Name" :value tt-name)
|
||||
:c2 (~events-ticket-type-col :label "Cost" :value cost-str)
|
||||
:c3 (~events-ticket-type-col :label "Count" :value count-str)
|
||||
:c1 (~page/ticket-type-col :label "Name" :value tt-name)
|
||||
:c2 (~page/ticket-type-col :label "Cost" :value cost-str)
|
||||
:c3 (~page/ticket-type-col :label "Count" :value count-str)
|
||||
:pre-action pre-action :edit-url edit-url)
|
||||
:menu (~events-admin-placeholder-nav))
|
||||
:menu (~forms/admin-placeholder-nav))
|
||||
|
||||
;; My tickets
|
||||
(defpage my-tickets
|
||||
@@ -150,16 +150,16 @@
|
||||
:auth :public
|
||||
:layout :root
|
||||
:data (tickets-data)
|
||||
:content (~events-tickets-panel
|
||||
:content (~tickets/panel
|
||||
:list-container list-container
|
||||
:has-tickets has-tickets
|
||||
:cards (when has-tickets
|
||||
(<> (map (fn (t)
|
||||
(~events-ticket-card
|
||||
(~tickets/card
|
||||
:href (get t "href") :entry-name (get t "entry-name")
|
||||
:type-name (get t "type-name") :time-str (get t "time-str")
|
||||
:cal-name (get t "cal-name")
|
||||
:badge (~badge :cls (get t "badge-cls") :label (get t "badge-label"))
|
||||
:badge (~shared:misc/badge :cls (get t "badge-cls") :label (get t "badge-label"))
|
||||
:code-prefix (get t "code-prefix")))
|
||||
tickets-list)))))
|
||||
|
||||
@@ -169,7 +169,7 @@
|
||||
:auth :public
|
||||
:layout :root
|
||||
:data (ticket-detail-data code)
|
||||
:content (~events-ticket-detail
|
||||
:content (~tickets/detail
|
||||
:list-container list-container :back-href back-href
|
||||
:header-bg header-bg :entry-name entry-name
|
||||
:badge (span :class (str "inline-flex items-center rounded-full px-3 py-1 text-sm font-medium " badge-cls)
|
||||
@@ -185,10 +185,10 @@
|
||||
:auth :admin
|
||||
:layout :root
|
||||
:data (ticket-admin-data)
|
||||
:content (~events-ticket-admin-panel
|
||||
:content (~tickets/admin-panel
|
||||
:list-container list-container
|
||||
:stats (<> (map (fn (s)
|
||||
(~events-ticket-admin-stat
|
||||
(~tickets/admin-stat
|
||||
:border (get s "border") :bg (get s "bg")
|
||||
:text-cls (get s "text-cls") :label-cls (get s "label-cls")
|
||||
:value (get s "value") :label (get s "label")))
|
||||
@@ -196,18 +196,18 @@
|
||||
:lookup-url lookup-url :has-tickets has-tickets
|
||||
:rows (when has-tickets
|
||||
(<> (map (fn (t)
|
||||
(~events-ticket-admin-row
|
||||
(~tickets/admin-row
|
||||
:code (get t "code") :code-short (get t "code-short")
|
||||
:entry-name (get t "entry-name")
|
||||
:date (when (get t "date-str")
|
||||
(~events-ticket-admin-date :date-str (get t "date-str")))
|
||||
(~tickets/admin-date :date-str (get t "date-str")))
|
||||
:type-name (get t "type-name")
|
||||
:badge (~badge :cls (get t "badge-cls") :label (get t "badge-label"))
|
||||
:badge (~shared:misc/badge :cls (get t "badge-cls") :label (get t "badge-label"))
|
||||
:action (if (get t "can-checkin")
|
||||
(~events-ticket-admin-checkin-form
|
||||
(~tickets/admin-checkin-form
|
||||
:checkin-url (get t "checkin-url") :code (get t "code") :csrf csrf)
|
||||
(when (get t "is-checked-in")
|
||||
(~events-ticket-admin-checked-in :time-str (get t "checkin-time"))))))
|
||||
(~tickets/admin-checked-in :time-str (get t "checkin-time"))))))
|
||||
admin-tickets)))))
|
||||
|
||||
;; Markets
|
||||
@@ -216,20 +216,20 @@
|
||||
:auth :public
|
||||
:layout :events-markets
|
||||
:data (markets-data)
|
||||
:content (~crud-panel
|
||||
:content (~shared:misc/crud-panel
|
||||
:list-id "markets-list"
|
||||
:form (when can-create
|
||||
(~crud-create-form :create-url create-url :csrf csrf
|
||||
(~shared:misc/crud-create-form :create-url create-url :csrf csrf
|
||||
:errors-id "market-create-errors" :list-id "markets-list"
|
||||
:placeholder "e.g. Farm Shop, Bakery" :btn-label "Add market"))
|
||||
:list (if markets-list
|
||||
(<> (map (fn (m)
|
||||
(~crud-item :href (get m "href") :name (get m "name")
|
||||
(~shared:misc/crud-item :href (get m "href") :name (get m "name")
|
||||
:slug (get m "slug") :del-url (get m "del-url")
|
||||
:csrf-hdr (get m "csrf-hdr")
|
||||
:list-id "markets-list"
|
||||
:confirm-title "Delete market?"
|
||||
:confirm-text "Products will be hidden (soft delete)"))
|
||||
markets-list))
|
||||
(~empty-state :message "No markets yet. Create one above."
|
||||
(~shared:misc/empty-state :message "No markets yet. Create one above."
|
||||
:cls "text-gray-500 mt-4"))))
|
||||
|
||||
@@ -44,7 +44,7 @@ async def render_all_events_page(ctx: dict, entries, has_more, pending_tickets,
|
||||
ctx, entries, has_more, pending_tickets, page_info,
|
||||
page, view, ticket_url, next_url, events_url,
|
||||
)
|
||||
hdr = await render_to_sx_with_env("layout-root-full", {})
|
||||
hdr = await render_to_sx_with_env("shared:layout/root-full", {})
|
||||
return await full_page_sx(ctx, header_rows=hdr, content=content)
|
||||
|
||||
|
||||
@@ -105,7 +105,7 @@ async def render_page_summary_page(ctx: dict, entries, has_more, pending_tickets
|
||||
is_page_scoped=True, post=post,
|
||||
)
|
||||
|
||||
hdr = await render_to_sx_with_env("layout-root-full", {})
|
||||
hdr = await render_to_sx_with_env("shared:layout/root-full", {})
|
||||
hdr += await header_child_sx(await _post_header_sx(ctx))
|
||||
return await full_page_sx(ctx, header_rows=hdr, content=content)
|
||||
|
||||
@@ -160,7 +160,7 @@ async def render_calendars_page(ctx: dict) -> str:
|
||||
content = _calendars_main_panel_sx(ctx)
|
||||
ctx = await _ensure_container_nav(ctx)
|
||||
slug = (ctx.get("post") or {}).get("slug", "")
|
||||
root_hdr = await render_to_sx_with_env("layout-root-full", {})
|
||||
root_hdr = await render_to_sx_with_env("shared:layout/root-full", {})
|
||||
post_hdr = await _post_header_sx(ctx)
|
||||
admin_hdr = await post_admin_header_sx(ctx, slug, selected="calendars")
|
||||
return await full_page_sx(ctx, header_rows=root_hdr + post_hdr + admin_hdr, content=content)
|
||||
@@ -183,7 +183,7 @@ async def render_calendars_oob(ctx: dict) -> str:
|
||||
async def render_calendar_page(ctx: dict) -> str:
|
||||
"""Full page: calendar month view."""
|
||||
content = _calendar_main_panel_html(ctx)
|
||||
hdr = await render_to_sx_with_env("layout-root-full", {})
|
||||
hdr = await render_to_sx_with_env("shared:layout/root-full", {})
|
||||
child = await _post_header_sx(ctx) + _calendar_header_sx(ctx)
|
||||
hdr += await header_child_sx(child)
|
||||
return await full_page_sx(ctx, header_rows=hdr, content=content)
|
||||
@@ -206,7 +206,7 @@ async def render_calendar_oob(ctx: dict) -> str:
|
||||
async def render_day_page(ctx: dict) -> str:
|
||||
"""Full page: day detail."""
|
||||
content = _day_main_panel_html(ctx)
|
||||
hdr = await render_to_sx_with_env("layout-root-full", {})
|
||||
hdr = await render_to_sx_with_env("shared:layout/root-full", {})
|
||||
child = (await _post_header_sx(ctx)
|
||||
+ _calendar_header_sx(ctx) + _day_header_sx(ctx))
|
||||
hdr += await header_child_sx(child)
|
||||
|
||||
@@ -117,7 +117,7 @@ def _cart_icon_oob(count: int) -> str:
|
||||
|
||||
|
||||
def _cart_icon_ctx(count: int) -> dict:
|
||||
"""Return data dict for the ~events-cart-icon component."""
|
||||
"""Return data dict for the ~page/cart-icon component."""
|
||||
from quart import g
|
||||
|
||||
blog_url_fn = getattr(g, "blog_url", None)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
;; Auth components (choose username — federation-specific)
|
||||
;; Login and check-email components are shared: see shared/sx/templates/auth.sx
|
||||
|
||||
(defcomp ~federation-choose-username (&key domain error csrf username check-url)
|
||||
(defcomp ~auth/choose-username (&key (domain :as string) error (csrf :as string) (username :as string) (check-url :as string))
|
||||
(div :class "py-8 max-w-md mx-auto"
|
||||
(h1 :class "text-2xl font-bold mb-2" "Choose your username")
|
||||
(p :class "text-stone-600 mb-6" "This will be your identity on the fediverse: "
|
||||
|
||||
@@ -12,7 +12,7 @@
|
||||
(let ((actor (service "federation" "get-actor-by-username" :username u)))
|
||||
(<> (str "<!-- fragment:" u " -->")
|
||||
(when (not (nil? actor))
|
||||
(~link-card
|
||||
(~shared:fragments/link-card
|
||||
:link (app-url "federation"
|
||||
(str "/users/" (get actor "preferred_username")))
|
||||
:title (or (get actor "display_name")
|
||||
@@ -28,7 +28,7 @@
|
||||
(let ((actor (service "federation" "get-actor-by-username"
|
||||
:username lookup)))
|
||||
(when (not (nil? actor))
|
||||
(~link-card
|
||||
(~shared:fragments/link-card
|
||||
:link (app-url "federation"
|
||||
(str "/users/" (get actor "preferred_username")))
|
||||
:title (or (get actor "display_name")
|
||||
|
||||
@@ -2,16 +2,16 @@
|
||||
;; Registered via register_sx_layout("social", ...) in __init__.py.
|
||||
|
||||
;; Full page: root header + social header in header-child
|
||||
(defcomp ~social-layout-full ()
|
||||
(defcomp ~layouts/social-layout-full ()
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
:inner (~federation-social-header
|
||||
:nav (~federation-social-nav :actor (federation-actor-ctx))))))
|
||||
(~shared:layout/header-child-sx
|
||||
:inner (~social/header
|
||||
:nav (~social/nav :actor (federation-actor-ctx))))))
|
||||
|
||||
;; OOB (HTMX): social header oob + root header oob
|
||||
(defcomp ~social-layout-oob ()
|
||||
(<> (~oob-header-sx
|
||||
(defcomp ~layouts/social-layout-oob ()
|
||||
(<> (~shared:layout/oob-header-sx
|
||||
:parent-id "root-header-child"
|
||||
:row (~federation-social-header
|
||||
:nav (~federation-social-nav :actor (federation-actor-ctx))))
|
||||
:row (~social/header
|
||||
:nav (~social/nav :actor (federation-actor-ctx))))
|
||||
(~root-header-auto true)))
|
||||
|
||||
@@ -1,9 +1,9 @@
|
||||
;; Notification components
|
||||
|
||||
(defcomp ~federation-notification-preview (&key preview)
|
||||
(defcomp ~notifications/preview (&key (preview :as string))
|
||||
(div :class "text-sm text-stone-500 mt-1 truncate" preview))
|
||||
|
||||
(defcomp ~federation-notification-card (&key cls avatar from-name from-username from-domain action-text preview time)
|
||||
(defcomp ~notifications/card (&key (cls :as string) avatar (from-name :as string) (from-username :as string) (from-domain :as string) (action-text :as string) preview (time :as string))
|
||||
(div :class cls
|
||||
(div :class "flex items-start gap-3"
|
||||
avatar
|
||||
@@ -15,14 +15,14 @@
|
||||
preview
|
||||
(div :class "text-xs text-stone-400 mt-1" time)))))
|
||||
|
||||
(defcomp ~federation-notifications-list (&key items)
|
||||
(defcomp ~notifications/list (&key (items :as list))
|
||||
(div :class "space-y-2" items))
|
||||
|
||||
(defcomp ~federation-notifications-page (&key notifs)
|
||||
(defcomp ~notifications/page (&key notifs)
|
||||
(h1 :class "text-2xl font-bold mb-6" "Notifications") notifs)
|
||||
|
||||
;; Assembled notification card — replaces Python _notification_sx
|
||||
(defcomp ~federation-notification-from-data (&key notif)
|
||||
(defcomp ~notifications/from-data (&key (notif :as dict))
|
||||
(let* ((from-name (or (get notif "from_actor_name") "?"))
|
||||
(from-username (or (get notif "from_actor_username") ""))
|
||||
(from-domain (or (get notif "from_actor_domain") ""))
|
||||
@@ -44,9 +44,9 @@
|
||||
((= ntype "mention") "mentioned you")
|
||||
((= ntype "reply") "replied to your post")
|
||||
(true ""))))
|
||||
(~federation-notification-card
|
||||
(~notifications/card
|
||||
:cls (str "bg-white rounded-lg shadow-sm border border-stone-200 p-4" border)
|
||||
:avatar (~avatar
|
||||
:avatar (~shared:misc/avatar
|
||||
:src from-icon
|
||||
:cls (if from-icon "w-8 h-8 rounded-full"
|
||||
"w-8 h-8 rounded-full bg-stone-300 flex items-center justify-center text-stone-600 font-bold text-xs")
|
||||
@@ -55,15 +55,15 @@
|
||||
:from-username (escape from-username)
|
||||
:from-domain (if from-domain (str "@" (escape from-domain)) "")
|
||||
:action-text action-text
|
||||
:preview (when preview (~federation-notification-preview :preview (escape preview)))
|
||||
:preview (when preview (~notifications/preview :preview (escape preview)))
|
||||
:time created)))
|
||||
|
||||
;; Assembled notifications content — replaces Python _notifications_content_sx
|
||||
(defcomp ~federation-notifications-content (&key notifications)
|
||||
(~federation-notifications-page
|
||||
(defcomp ~notifications/content (&key (notifications :as list))
|
||||
(~notifications/page
|
||||
:notifs (if (empty? notifications)
|
||||
(~empty-state :message "No notifications yet." :cls "text-stone-500")
|
||||
(~federation-notifications-list
|
||||
(~shared:misc/empty-state :message "No notifications yet." :cls "text-stone-500")
|
||||
(~notifications/list
|
||||
:items (map (lambda (n)
|
||||
(~federation-notification-from-data :notif n))
|
||||
(~notifications/from-data :notif n))
|
||||
notifications)))))
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Profile and actor timeline components
|
||||
|
||||
(defcomp ~federation-actor-profile-header (&key avatar display-name username domain summary follow)
|
||||
(defcomp ~profile/actor-profile-header (&key avatar (display-name :as string) (username :as string) (domain :as string) summary follow)
|
||||
(div :class "bg-white rounded-lg shadow-sm border border-stone-200 p-6 mb-6"
|
||||
(div :class "flex items-center gap-4"
|
||||
avatar
|
||||
@@ -10,39 +10,39 @@
|
||||
summary)
|
||||
follow)))
|
||||
|
||||
(defcomp ~federation-actor-timeline-layout (&key header timeline)
|
||||
(defcomp ~profile/actor-timeline-layout (&key header timeline)
|
||||
header
|
||||
(div :id "timeline" timeline))
|
||||
|
||||
(defcomp ~federation-follow-form (&key action csrf actor-url label cls)
|
||||
(defcomp ~profile/follow-form (&key (action :as string) (csrf :as string) (actor-url :as string) (label :as string) (cls :as string))
|
||||
(div :class "flex-shrink-0"
|
||||
(form :method "post" :action action
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(input :type "hidden" :name "actor_url" :value actor-url)
|
||||
(button :type "submit" :class cls label))))
|
||||
|
||||
(defcomp ~federation-profile-summary (&key summary)
|
||||
(defcomp ~profile/summary (&key (summary :as string))
|
||||
(div :class "text-sm text-stone-600 mt-2" (~rich-text :html summary)))
|
||||
|
||||
;; Public profile page
|
||||
|
||||
(defcomp ~federation-activity-obj-type (&key obj-type)
|
||||
(defcomp ~profile/activity-obj-type (&key (obj-type :as string))
|
||||
(span :class "text-sm text-stone-500" obj-type))
|
||||
|
||||
(defcomp ~federation-activity-card (&key activity-type published obj-type)
|
||||
(defcomp ~profile/activity-card (&key (activity-type :as string) (published :as string) obj-type)
|
||||
(div :class "bg-white rounded-lg shadow p-4"
|
||||
(div :class "flex justify-between items-start"
|
||||
(span :class "font-medium" activity-type)
|
||||
(span :class "text-sm text-stone-400" published))
|
||||
obj-type))
|
||||
|
||||
(defcomp ~federation-activities-list (&key items)
|
||||
(defcomp ~profile/activities-list (&key (items :as list))
|
||||
(div :class "space-y-4" items))
|
||||
|
||||
(defcomp ~federation-activities-empty ()
|
||||
(defcomp ~profile/activities-empty ()
|
||||
(p :class "text-stone-500" "No activities yet."))
|
||||
|
||||
(defcomp ~federation-profile-page (&key display-name username domain summary activities-heading activities)
|
||||
(defcomp ~profile/page (&key (display-name :as string) (username :as string) (domain :as string) summary (activities-heading :as string) activities)
|
||||
(div :class "py-8"
|
||||
(div :class "bg-white rounded-lg shadow p-6 mb-6"
|
||||
(h1 :class "text-2xl font-bold" display-name)
|
||||
@@ -51,11 +51,11 @@
|
||||
(h2 :class "text-xl font-bold mb-4" activities-heading)
|
||||
activities))
|
||||
|
||||
(defcomp ~federation-profile-summary-text (&key text)
|
||||
(defcomp ~profile/summary-text (&key (text :as string))
|
||||
(p :class "mt-2" text))
|
||||
|
||||
;; Assembled actor timeline content — replaces Python _actor_timeline_content_sx
|
||||
(defcomp ~federation-actor-timeline-content (&key remote-actor items is-following actor)
|
||||
(defcomp ~profile/actor-timeline-content (&key (remote-actor :as dict) (items :as list) (is-following :as boolean) actor)
|
||||
(let* ((display-name (or (get remote-actor "display_name") (get remote-actor "preferred_username") ""))
|
||||
(icon-url (get remote-actor "icon_url"))
|
||||
(summary (get remote-actor "summary"))
|
||||
@@ -63,9 +63,9 @@
|
||||
(csrf (csrf-token))
|
||||
(initial (if (and (not icon-url) display-name)
|
||||
(upper (slice display-name 0 1)) "?")))
|
||||
(~federation-actor-timeline-layout
|
||||
:header (~federation-actor-profile-header
|
||||
:avatar (~avatar
|
||||
(~profile/actor-timeline-layout
|
||||
:header (~profile/actor-profile-header
|
||||
:avatar (~shared:misc/avatar
|
||||
:src icon-url
|
||||
:cls (if icon-url "w-16 h-16 rounded-full"
|
||||
"w-16 h-16 rounded-full bg-stone-300 flex items-center justify-center text-stone-600 font-bold text-xl")
|
||||
@@ -73,18 +73,18 @@
|
||||
:display-name (escape display-name)
|
||||
:username (escape (or (get remote-actor "preferred_username") ""))
|
||||
:domain (escape (or (get remote-actor "domain") ""))
|
||||
:summary (when summary (~federation-profile-summary :summary summary))
|
||||
:summary (when summary (~profile/summary :summary summary))
|
||||
:follow (when actor
|
||||
(if is-following
|
||||
(~federation-follow-form
|
||||
(~profile/follow-form
|
||||
:action (url-for "social.unfollow") :csrf csrf :actor-url actor-url
|
||||
:label "Unfollow"
|
||||
:cls "border border-stone-300 rounded px-4 py-2 hover:bg-stone-100")
|
||||
(~federation-follow-form
|
||||
(~profile/follow-form
|
||||
:action (url-for "social.follow") :csrf csrf :actor-url actor-url
|
||||
:label "Follow"
|
||||
:cls "bg-stone-800 text-white rounded px-4 py-2 hover:bg-stone-700"))))
|
||||
:timeline (~federation-timeline-items
|
||||
:timeline (~social/timeline-items
|
||||
:items items :timeline-type "actor" :actor actor
|
||||
:next-url (when (not (empty? items))
|
||||
(url-for "social.actor_timeline_page"
|
||||
@@ -92,14 +92,14 @@
|
||||
:before (get (last items) "before_cursor")))))))
|
||||
|
||||
;; Data-driven activities list (replaces Python loop in render_profile_page)
|
||||
(defcomp ~federation-activities-from-data (&key activities)
|
||||
(defcomp ~profile/activities-from-data (&key (activities :as list))
|
||||
(if (empty? (or activities (list)))
|
||||
(~federation-activities-empty)
|
||||
(~federation-activities-list
|
||||
(~profile/activities-empty)
|
||||
(~profile/activities-list
|
||||
:items (<> (map (lambda (a)
|
||||
(~federation-activity-card
|
||||
(~profile/activity-card
|
||||
:activity-type (get a "activity_type")
|
||||
:published (get a "published")
|
||||
:obj-type (when (get a "object_type")
|
||||
(~federation-activity-obj-type :obj-type (get a "object_type")))))
|
||||
(~profile/activity-obj-type :obj-type (get a "object_type")))))
|
||||
activities)))))
|
||||
|
||||
@@ -1,37 +1,37 @@
|
||||
;; Search and actor card components
|
||||
|
||||
;; Aliases — delegate to shared ~avatar
|
||||
(defcomp ~federation-actor-avatar-img (&key src cls)
|
||||
(~avatar :src src :cls cls))
|
||||
;; Aliases — delegate to shared ~shared:misc/avatar
|
||||
(defcomp ~search/actor-avatar-img (&key (src :as string) (cls :as string))
|
||||
(~shared:misc/avatar :src src :cls cls))
|
||||
|
||||
(defcomp ~federation-actor-avatar-placeholder (&key cls initial)
|
||||
(~avatar :cls cls :initial initial))
|
||||
(defcomp ~search/actor-avatar-placeholder (&key (cls :as string) (initial :as string))
|
||||
(~shared:misc/avatar :cls cls :initial initial))
|
||||
|
||||
(defcomp ~federation-actor-name-link (&key href name)
|
||||
(defcomp ~search/actor-name-link (&key (href :as string) (name :as string))
|
||||
(a :href href :class "font-semibold text-stone-900 hover:underline" name))
|
||||
|
||||
(defcomp ~federation-actor-name-link-external (&key href name)
|
||||
(defcomp ~search/actor-name-link-external (&key (href :as string) (name :as string))
|
||||
(a :href href :target "_blank" :rel "noopener"
|
||||
:class "font-semibold text-stone-900 hover:underline" name))
|
||||
|
||||
(defcomp ~federation-actor-summary (&key summary)
|
||||
(defcomp ~search/actor-summary (&key (summary :as string))
|
||||
(div :class "text-sm text-stone-600 mt-1 truncate" (~rich-text :html summary)))
|
||||
|
||||
(defcomp ~federation-unfollow-button (&key action csrf actor-url)
|
||||
(defcomp ~search/unfollow-button (&key (action :as string) (csrf :as string) (actor-url :as string))
|
||||
(div :class "flex-shrink-0"
|
||||
(form :method "post" :action action :sx-post action :sx-target "closest article" :sx-swap "outerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(input :type "hidden" :name "actor_url" :value actor-url)
|
||||
(button :type "submit" :class "text-sm border border-stone-300 rounded px-3 py-1 hover:bg-stone-100" "Unfollow"))))
|
||||
|
||||
(defcomp ~federation-follow-button (&key action csrf actor-url label)
|
||||
(defcomp ~search/follow-button (&key (action :as string) (csrf :as string) (actor-url :as string) (label :as string))
|
||||
(div :class "flex-shrink-0"
|
||||
(form :method "post" :action action :sx-post action :sx-target "closest article" :sx-swap "outerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(input :type "hidden" :name "actor_url" :value actor-url)
|
||||
(button :type "submit" :class "text-sm bg-stone-800 text-white rounded px-3 py-1 hover:bg-stone-700" label))))
|
||||
|
||||
(defcomp ~federation-actor-card (&key cls id avatar name username domain summary button)
|
||||
(defcomp ~search/actor-card (&key (cls :as string) (id :as string) avatar name (username :as string) (domain :as string) summary button)
|
||||
(article :class cls :id id
|
||||
avatar
|
||||
(div :class "flex-1 min-w-0"
|
||||
@@ -41,7 +41,7 @@
|
||||
button))
|
||||
|
||||
;; Data-driven actor card (replaces Python _actor_card_sx loop)
|
||||
(defcomp ~federation-actor-card-from-data (&key d has-actor csrf follow-url unfollow-url list-type)
|
||||
(defcomp ~search/actor-card-from-data (&key (d :as dict) (has-actor :as boolean) (csrf :as string) (follow-url :as string) (unfollow-url :as string) (list-type :as string))
|
||||
(let* ((icon-url (get d "icon_url"))
|
||||
(display-name (get d "display_name"))
|
||||
(username (get d "username"))
|
||||
@@ -49,42 +49,42 @@
|
||||
(actor-url (get d "actor_url"))
|
||||
(safe-id (get d "safe_id"))
|
||||
(initial (or (get d "initial") "?"))
|
||||
(avatar (~avatar
|
||||
(avatar (~shared:misc/avatar
|
||||
:src icon-url
|
||||
:cls (if icon-url "w-12 h-12 rounded-full"
|
||||
"w-12 h-12 rounded-full bg-stone-300 flex items-center justify-center text-stone-600 font-bold")
|
||||
:initial (when (not icon-url) initial)))
|
||||
(name-sx (if (get d "external_link")
|
||||
(~federation-actor-name-link-external :href (get d "name_href") :name display-name)
|
||||
(~federation-actor-name-link :href (get d "name_href") :name display-name)))
|
||||
(~search/actor-name-link-external :href (get d "name_href") :name display-name)
|
||||
(~search/actor-name-link :href (get d "name_href") :name display-name)))
|
||||
(summary-sx (when (get d "summary")
|
||||
(~federation-actor-summary :summary (get d "summary"))))
|
||||
(~search/actor-summary :summary (get d "summary"))))
|
||||
(is-followed (get d "is_followed"))
|
||||
(button (when has-actor
|
||||
(if (or (= list-type "following") is-followed)
|
||||
(~federation-unfollow-button :action unfollow-url :csrf csrf :actor-url actor-url)
|
||||
(~federation-follow-button :action follow-url :csrf csrf :actor-url actor-url
|
||||
(~search/unfollow-button :action unfollow-url :csrf csrf :actor-url actor-url)
|
||||
(~search/follow-button :action follow-url :csrf csrf :actor-url actor-url
|
||||
:label (if (= list-type "followers") "Follow Back" "Follow"))))))
|
||||
(~federation-actor-card
|
||||
(~search/actor-card
|
||||
:cls "bg-white rounded-lg shadow-sm border border-stone-200 p-4 mb-3 flex items-center gap-4"
|
||||
:id (str "actor-" safe-id)
|
||||
:avatar avatar :name name-sx :username username :domain domain
|
||||
:summary summary-sx :button button)))
|
||||
|
||||
;; Data-driven actor list (replaces Python _search_results_sx / _actor_list_items_sx loops)
|
||||
(defcomp ~federation-actor-list-from-data (&key actors next-url has-actor csrf
|
||||
follow-url unfollow-url list-type)
|
||||
(defcomp ~search/actor-list-from-data (&key (actors :as list) (next-url :as string?) (has-actor :as boolean) (csrf :as string)
|
||||
(follow-url :as string) (unfollow-url :as string) (list-type :as string))
|
||||
(<>
|
||||
(map (lambda (d)
|
||||
(~federation-actor-card-from-data :d d :has-actor has-actor :csrf csrf
|
||||
(~search/actor-card-from-data :d d :has-actor has-actor :csrf csrf
|
||||
:follow-url follow-url :unfollow-url unfollow-url :list-type list-type))
|
||||
(or actors (list)))
|
||||
(when next-url (~federation-scroll-sentinel :url next-url))))
|
||||
(when next-url (~social/scroll-sentinel :url next-url))))
|
||||
|
||||
(defcomp ~federation-search-info (&key cls text)
|
||||
(defcomp ~search/info (&key (cls :as string) (text :as string))
|
||||
(p :class cls text))
|
||||
|
||||
(defcomp ~federation-search-page (&key search-url search-page-url query info results)
|
||||
(defcomp ~search/page (&key (search-url :as string) (search-page-url :as string) (query :as string) info results)
|
||||
(h1 :class "text-2xl font-bold mb-6" "Search")
|
||||
(form :method "get" :action search-url :class "mb-6"
|
||||
:sx-get search-page-url :sx-target "#search-results" :sx-push-url search-url
|
||||
@@ -97,7 +97,7 @@
|
||||
(div :id "search-results" results))
|
||||
|
||||
;; Following / Followers list page
|
||||
(defcomp ~federation-actor-list-page (&key title count-str items)
|
||||
(defcomp ~search/actor-list-page (&key (title :as string) (count-str :as string) items)
|
||||
(h1 :class "text-2xl font-bold mb-6" title " "
|
||||
(span :class "text-stone-400 font-normal" count-str))
|
||||
(div :id "actor-list" items))
|
||||
@@ -106,7 +106,7 @@
|
||||
;; Assembled actor card — replaces Python _actor_card_sx
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~federation-actor-card-from-data (&key a actor followed-urls list-type)
|
||||
(defcomp ~search/actor-card-from-data (&key (a :as dict) actor (followed-urls :as list) (list-type :as string))
|
||||
(let* ((display-name (or (get a "display_name") (get a "preferred_username") ""))
|
||||
(username (or (get a "preferred_username") ""))
|
||||
(domain (or (get a "domain") ""))
|
||||
@@ -119,81 +119,81 @@
|
||||
(upper (slice (or display-name username) 0 1)) "?"))
|
||||
(csrf (csrf-token))
|
||||
(is-followed (contains? (or followed-urls (list)) actor-url)))
|
||||
(~federation-actor-card
|
||||
(~search/actor-card
|
||||
:cls "bg-white rounded-lg shadow-sm border border-stone-200 p-4 mb-3 flex items-center gap-4"
|
||||
:id (str "actor-" safe-id)
|
||||
:avatar (~avatar
|
||||
:avatar (~shared:misc/avatar
|
||||
:src icon-url
|
||||
:cls (if icon-url "w-12 h-12 rounded-full"
|
||||
"w-12 h-12 rounded-full bg-stone-300 flex items-center justify-center text-stone-600 font-bold")
|
||||
:initial (when (not icon-url) initial))
|
||||
:name (if (and (or (= list-type "following") (= list-type "search")) aid)
|
||||
(~federation-actor-name-link
|
||||
(~search/actor-name-link
|
||||
:href (url-for "social.defpage_actor_timeline" :id aid)
|
||||
:name (escape display-name))
|
||||
(~federation-actor-name-link-external
|
||||
(~search/actor-name-link-external
|
||||
:href (str "https://" domain "/@" username)
|
||||
:name (escape display-name)))
|
||||
:username (escape username)
|
||||
:domain (escape domain)
|
||||
:summary (when summary (~federation-actor-summary :summary summary))
|
||||
:summary (when summary (~search/actor-summary :summary summary))
|
||||
:button (when actor
|
||||
(if (or (= list-type "following") is-followed)
|
||||
(~federation-unfollow-button
|
||||
(~search/unfollow-button
|
||||
:action (url-for "social.unfollow") :csrf csrf :actor-url actor-url)
|
||||
(~federation-follow-button
|
||||
(~search/follow-button
|
||||
:action (url-for "social.follow") :csrf csrf :actor-url actor-url
|
||||
:label (if (= list-type "followers") "Follow Back" "Follow")))))))
|
||||
|
||||
;; Assembled search content — replaces Python _search_content_sx
|
||||
(defcomp ~federation-search-content (&key query actors total followed-urls actor)
|
||||
(~federation-search-page
|
||||
(defcomp ~search/content (&key (query :as string?) (actors :as list) (total :as number) (followed-urls :as list) actor)
|
||||
(~search/page
|
||||
:search-url (url-for "social.defpage_search")
|
||||
:search-page-url (url-for "social.search_page")
|
||||
:query (escape (or query ""))
|
||||
:info (cond
|
||||
((and query (> total 0))
|
||||
(~federation-search-info
|
||||
(~search/info
|
||||
:cls "text-sm text-stone-500 mb-4"
|
||||
:text (str total " result" (pluralize total) " for " (escape query))))
|
||||
(query
|
||||
(~federation-search-info
|
||||
(~search/info
|
||||
:cls "text-stone-500 mb-4"
|
||||
:text (str "No results found for " (escape query))))
|
||||
(true nil))
|
||||
:results (when (not (empty? actors))
|
||||
(<>
|
||||
(map (lambda (a)
|
||||
(~federation-actor-card-from-data
|
||||
(~search/actor-card-from-data
|
||||
:a a :actor actor :followed-urls followed-urls :list-type "search"))
|
||||
actors)
|
||||
(when (>= (len actors) 20)
|
||||
(~federation-scroll-sentinel
|
||||
(~social/scroll-sentinel
|
||||
:url (url-for "social.search_page" :q query :page 2)))))))
|
||||
|
||||
;; Assembled following/followers content — replaces Python _following_content_sx etc.
|
||||
(defcomp ~federation-following-content (&key actors total actor)
|
||||
(~federation-actor-list-page
|
||||
(defcomp ~search/following-content (&key (actors :as list) (total :as number) actor)
|
||||
(~search/actor-list-page
|
||||
:title "Following" :count-str (str "(" total ")")
|
||||
:items (when (not (empty? actors))
|
||||
(<>
|
||||
(map (lambda (a)
|
||||
(~federation-actor-card-from-data
|
||||
(~search/actor-card-from-data
|
||||
:a a :actor actor :followed-urls (list) :list-type "following"))
|
||||
actors)
|
||||
(when (>= (len actors) 20)
|
||||
(~federation-scroll-sentinel
|
||||
(~social/scroll-sentinel
|
||||
:url (url-for "social.following_list_page" :page 2)))))))
|
||||
|
||||
(defcomp ~federation-followers-content (&key actors total followed-urls actor)
|
||||
(~federation-actor-list-page
|
||||
(defcomp ~search/followers-content (&key (actors :as list) (total :as number) (followed-urls :as list) actor)
|
||||
(~search/actor-list-page
|
||||
:title "Followers" :count-str (str "(" total ")")
|
||||
:items (when (not (empty? actors))
|
||||
(<>
|
||||
(map (lambda (a)
|
||||
(~federation-actor-card-from-data
|
||||
(~search/actor-card-from-data
|
||||
:a a :actor actor :followed-urls followed-urls :list-type "followers"))
|
||||
actors)
|
||||
(when (>= (len actors) 20)
|
||||
(~federation-scroll-sentinel
|
||||
(~social/scroll-sentinel
|
||||
:url (url-for "social.followers_list_page" :page 2)))))))
|
||||
|
||||
@@ -2,46 +2,46 @@
|
||||
|
||||
;; --- Navigation ---
|
||||
|
||||
(defcomp ~federation-nav-choose-username (&key url)
|
||||
(defcomp ~social/nav-choose-username (&key (url :as string))
|
||||
(nav :class "flex gap-3 text-sm items-center"
|
||||
(a :href url :class "px-2 py-1 rounded hover:bg-stone-200 font-bold" "Choose username")))
|
||||
|
||||
(defcomp ~federation-nav-notification-link (&key href cls count-url)
|
||||
(defcomp ~social/nav-notification-link (&key (href :as string) (cls :as string) (count-url :as string))
|
||||
(a :href href :class cls "Notifications"
|
||||
(span :sx-get count-url :sx-trigger "load, every 30s" :sx-swap "innerHTML"
|
||||
:class "absolute -top-2 -right-3 text-xs bg-red-500 text-white rounded-full px-1 empty:hidden")))
|
||||
|
||||
(defcomp ~federation-nav-bar (&key items)
|
||||
(defcomp ~social/nav-bar (&key items)
|
||||
(nav :class "flex gap-3 text-sm items-center flex-wrap" items))
|
||||
|
||||
(defcomp ~federation-social-header (&key nav)
|
||||
(defcomp ~social/header (&key nav)
|
||||
(div :id "social-row" :class "flex flex-col items-center md:flex-row justify-center md:justify-between w-full p-1 bg-sky-400"
|
||||
(div :class "w-full flex flex-row items-center gap-2 flex-wrap" nav)))
|
||||
|
||||
;; --- Post card ---
|
||||
|
||||
(defcomp ~federation-boost-label (&key name)
|
||||
(defcomp ~social/boost-label (&key (name :as string))
|
||||
(div :class "text-sm text-stone-500 mb-2" "Boosted by " name))
|
||||
|
||||
;; Aliases — delegate to shared ~avatar
|
||||
(defcomp ~federation-avatar-img (&key src cls)
|
||||
(~avatar :src src :cls cls))
|
||||
;; Aliases — delegate to shared ~shared:misc/avatar
|
||||
(defcomp ~social/avatar-img (&key (src :as string) (cls :as string))
|
||||
(~shared:misc/avatar :src src :cls cls))
|
||||
|
||||
(defcomp ~federation-avatar-placeholder (&key cls initial)
|
||||
(~avatar :cls cls :initial initial))
|
||||
(defcomp ~social/avatar-placeholder (&key (cls :as string) (initial :as string))
|
||||
(~shared:misc/avatar :cls cls :initial initial))
|
||||
|
||||
(defcomp ~federation-content (&key content summary)
|
||||
(defcomp ~social/content (&key (content :as string) (summary :as string?))
|
||||
(if summary
|
||||
(details :class "mt-2"
|
||||
(summary :class "text-stone-500 cursor-pointer" "CW: " (~rich-text :html summary))
|
||||
(div :class "mt-2 prose prose-sm prose-stone max-w-none" (~rich-text :html content)))
|
||||
(div :class "mt-2 prose prose-sm prose-stone max-w-none" (~rich-text :html content))))
|
||||
|
||||
(defcomp ~federation-original-link (&key url)
|
||||
(defcomp ~social/original-link (&key (url :as string))
|
||||
(a :href url :target "_blank" :rel "noopener"
|
||||
:class "text-sm text-stone-400 hover:underline mt-1 inline-block" "original"))
|
||||
|
||||
(defcomp ~federation-post-card (&key boost avatar actor-name actor-username domain time content original interactions)
|
||||
(defcomp ~social/post-card (&key boost avatar (actor-name :as string) (actor-username :as string) (domain :as string) (time :as string) content original interactions)
|
||||
(article :class "bg-white rounded-lg shadow-sm border border-stone-200 p-4 mb-4"
|
||||
boost
|
||||
(div :class "flex items-start gap-3"
|
||||
@@ -55,36 +55,36 @@
|
||||
|
||||
;; --- Interaction buttons ---
|
||||
|
||||
(defcomp ~federation-reply-link (&key url)
|
||||
(defcomp ~social/reply-link (&key (url :as string))
|
||||
(a :href url :class "hover:text-stone-700" "Reply"))
|
||||
|
||||
(defcomp ~federation-like-form (&key action target oid ainbox csrf cls icon count)
|
||||
(defcomp ~social/like-form (&key (action :as string) (target :as string) (oid :as string) (ainbox :as string) (csrf :as string) (cls :as string) (icon :as string) count)
|
||||
(form :sx-post action :sx-target target :sx-swap "innerHTML"
|
||||
(input :type "hidden" :name "object_id" :value oid)
|
||||
(input :type "hidden" :name "author_inbox" :value ainbox)
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit" :class cls (span icon) " " count)))
|
||||
|
||||
(defcomp ~federation-boost-form (&key action target oid ainbox csrf cls count)
|
||||
(defcomp ~social/boost-form (&key (action :as string) (target :as string) (oid :as string) (ainbox :as string) (csrf :as string) (cls :as string) count)
|
||||
(form :sx-post action :sx-target target :sx-swap "innerHTML"
|
||||
(input :type "hidden" :name "object_id" :value oid)
|
||||
(input :type "hidden" :name "author_inbox" :value ainbox)
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit" :class cls (span "\u21bb") " " count)))
|
||||
|
||||
(defcomp ~federation-interaction-buttons (&key like boost reply)
|
||||
(defcomp ~social/interaction-buttons (&key like boost reply)
|
||||
(div :class "flex items-center gap-4 mt-3 text-sm text-stone-500"
|
||||
like boost reply))
|
||||
|
||||
;; --- Timeline ---
|
||||
|
||||
(defcomp ~federation-scroll-sentinel (&key url)
|
||||
(defcomp ~social/scroll-sentinel (&key (url :as string))
|
||||
(div :sx-get url :sx-trigger "revealed" :sx-swap "outerHTML"))
|
||||
|
||||
(defcomp ~federation-compose-button (&key url)
|
||||
(defcomp ~social/compose-button (&key (url :as string))
|
||||
(a :href url :class "bg-stone-800 text-white px-4 py-2 rounded hover:bg-stone-700" "Compose"))
|
||||
|
||||
(defcomp ~federation-timeline-page (&key label compose timeline)
|
||||
(defcomp ~social/timeline-page (&key (label :as string) compose timeline)
|
||||
(div :class "flex items-center justify-between mb-6"
|
||||
(h1 :class "text-2xl font-bold" label " Timeline")
|
||||
compose)
|
||||
@@ -92,24 +92,24 @@
|
||||
|
||||
;; --- Data-driven post card (replaces Python _post_card_sx loop) ---
|
||||
|
||||
(defcomp ~federation-post-card-from-data (&key d has-actor csrf
|
||||
like-url unlike-url
|
||||
boost-url unboost-url)
|
||||
(defcomp ~social/post-card-from-data (&key (d :as dict) (has-actor :as boolean) (csrf :as string)
|
||||
(like-url :as string) (unlike-url :as string)
|
||||
(boost-url :as string) (unboost-url :as string))
|
||||
(let* ((boosted-by (get d "boosted_by"))
|
||||
(actor-icon (get d "actor_icon"))
|
||||
(actor-name (get d "actor_name"))
|
||||
(initial (or (get d "initial") "?"))
|
||||
(avatar (~avatar
|
||||
(avatar (~shared:misc/avatar
|
||||
:src actor-icon
|
||||
:cls (if actor-icon "w-10 h-10 rounded-full"
|
||||
"w-10 h-10 rounded-full bg-stone-300 flex items-center justify-center text-stone-600 font-bold text-sm")
|
||||
:initial (when (not actor-icon) initial)))
|
||||
(boost (when boosted-by (~federation-boost-label :name boosted-by)))
|
||||
(boost (when boosted-by (~social/boost-label :name boosted-by)))
|
||||
(content-sx (if (get d "summary")
|
||||
(~federation-content :content (get d "content") :summary (get d "summary"))
|
||||
(~federation-content :content (get d "content"))))
|
||||
(~social/content :content (get d "content") :summary (get d "summary"))
|
||||
(~social/content :content (get d "content"))))
|
||||
(original (when (get d "original_url")
|
||||
(~federation-original-link :url (get d "original_url"))))
|
||||
(~social/original-link :url (get d "original_url"))))
|
||||
(safe-id (get d "safe_id"))
|
||||
(interactions (when has-actor
|
||||
(let* ((oid (get d "object_id"))
|
||||
@@ -123,16 +123,16 @@
|
||||
(b-action (if boosted-me unboost-url boost-url))
|
||||
(b-cls (str "flex items-center gap-1 " (if boosted-me "text-green-600 hover:text-green-700" "hover:text-green-600")))
|
||||
(reply-url (get d "reply_url"))
|
||||
(reply (when reply-url (~federation-reply-link :url reply-url)))
|
||||
(like-form (~federation-like-form
|
||||
(reply (when reply-url (~social/reply-link :url reply-url)))
|
||||
(like-form (~social/like-form
|
||||
:action l-action :target target :oid oid :ainbox ainbox
|
||||
:csrf csrf :cls l-cls :icon l-icon :count (get d "like_count")))
|
||||
(boost-form (~federation-boost-form
|
||||
(boost-form (~social/boost-form
|
||||
:action b-action :target target :oid oid :ainbox ainbox
|
||||
:csrf csrf :cls b-cls :count (get d "boost_count"))))
|
||||
(div :id (str "interactions-" safe-id)
|
||||
(~federation-interaction-buttons :like like-form :boost boost-form :reply reply))))))
|
||||
(~federation-post-card
|
||||
(~social/interaction-buttons :like like-form :boost boost-form :reply reply))))))
|
||||
(~social/post-card
|
||||
:boost boost :avatar avatar
|
||||
:actor-name actor-name :actor-username (get d "actor_username")
|
||||
:domain (get d "domain") :time (get d "time")
|
||||
@@ -140,22 +140,22 @@
|
||||
:interactions interactions)))
|
||||
|
||||
;; Data-driven timeline items (replaces Python _timeline_items_sx loop)
|
||||
(defcomp ~federation-timeline-items-from-data (&key items next-url has-actor csrf
|
||||
like-url unlike-url boost-url unboost-url)
|
||||
(defcomp ~social/timeline-items-from-data (&key (items :as list) (next-url :as string?) (has-actor :as boolean) (csrf :as string)
|
||||
(like-url :as string) (unlike-url :as string) (boost-url :as string) (unboost-url :as string))
|
||||
(<>
|
||||
(map (lambda (d)
|
||||
(~federation-post-card-from-data :d d :has-actor has-actor :csrf csrf
|
||||
(~social/post-card-from-data :d d :has-actor has-actor :csrf csrf
|
||||
:like-url like-url :unlike-url unlike-url :boost-url boost-url :unboost-url unboost-url))
|
||||
(or items (list)))
|
||||
(when next-url (~federation-scroll-sentinel :url next-url))))
|
||||
(when next-url (~social/scroll-sentinel :url next-url))))
|
||||
|
||||
;; --- Compose ---
|
||||
|
||||
(defcomp ~federation-compose-reply (&key reply-to)
|
||||
(defcomp ~social/compose-reply (&key (reply-to :as string))
|
||||
(input :type "hidden" :name "in_reply_to" :value reply-to)
|
||||
(div :class "text-sm text-stone-500" "Replying to " (span :class "font-mono" reply-to)))
|
||||
|
||||
(defcomp ~federation-compose-form (&key action csrf reply)
|
||||
(defcomp ~social/compose-form (&key (action :as string) (csrf :as string) reply)
|
||||
(h1 :class "text-2xl font-bold mb-6" "Compose")
|
||||
(form :method "post" :action action :class "space-y-4"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
@@ -174,9 +174,9 @@
|
||||
;; Assembled social nav — replaces Python _social_nav_sx
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~federation-social-nav (&key actor)
|
||||
(defcomp ~social/nav (&key actor)
|
||||
(if (not actor)
|
||||
(~federation-nav-choose-username :url (url-for "identity.choose_username_form"))
|
||||
(~social/nav-choose-username :url (url-for "identity.choose_username_form"))
|
||||
(let* ((rp (request-path))
|
||||
(links (list
|
||||
(dict :endpoint "social.defpage_home_timeline" :label "Timeline")
|
||||
@@ -185,7 +185,7 @@
|
||||
(dict :endpoint "social.defpage_following_list" :label "Following")
|
||||
(dict :endpoint "social.defpage_followers_list" :label "Followers")
|
||||
(dict :endpoint "social.defpage_search" :label "Search"))))
|
||||
(~federation-nav-bar
|
||||
(~social/nav-bar
|
||||
:items (<>
|
||||
(map (lambda (lnk)
|
||||
(let* ((href (url-for (get lnk "endpoint")))
|
||||
@@ -196,7 +196,7 @@
|
||||
links)
|
||||
(let* ((notif-url (url-for "social.defpage_notifications"))
|
||||
(notif-bold (if (= rp notif-url) " font-bold" "")))
|
||||
(~federation-nav-notification-link
|
||||
(~social/nav-notification-link
|
||||
:href notif-url
|
||||
:cls (str "px-2 py-1 rounded hover:bg-stone-200 relative" notif-bold)
|
||||
:count-url (url-for "social.notification_count")))
|
||||
@@ -208,7 +208,7 @@
|
||||
;; Assembled post card — replaces Python _post_card_sx
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~federation-post-card-from-data (&key item actor)
|
||||
(defcomp ~social/post-card-from-data (&key (item :as dict) actor)
|
||||
(let* ((boosted-by (get item "boosted_by"))
|
||||
(actor-icon (get item "actor_icon"))
|
||||
(actor-name (or (get item "actor_name") "?"))
|
||||
@@ -223,9 +223,9 @@
|
||||
(safe-id (replace (replace oid "/" "_") ":" "_"))
|
||||
(initial (if (and (not actor-icon) actor-name)
|
||||
(upper (slice actor-name 0 1)) "?")))
|
||||
(~federation-post-card
|
||||
:boost (when boosted-by (~federation-boost-label :name (escape boosted-by)))
|
||||
:avatar (~avatar
|
||||
(~social/post-card
|
||||
:boost (when boosted-by (~social/boost-label :name (escape boosted-by)))
|
||||
:avatar (~shared:misc/avatar
|
||||
:src actor-icon
|
||||
:cls (if actor-icon "w-10 h-10 rounded-full"
|
||||
"w-10 h-10 rounded-full bg-stone-300 flex items-center justify-center text-stone-600 font-bold text-sm")
|
||||
@@ -235,10 +235,10 @@
|
||||
:domain (if actor-domain (str "@" (escape actor-domain)) "")
|
||||
:time published
|
||||
:content (if summary
|
||||
(~federation-content :content content :summary (escape summary))
|
||||
(~federation-content :content content))
|
||||
(~social/content :content content :summary (escape summary))
|
||||
(~social/content :content content))
|
||||
:original (when (and url (= post-type "remote"))
|
||||
(~federation-original-link :url url))
|
||||
(~social/original-link :url url))
|
||||
:interactions (when actor
|
||||
(let* ((csrf (csrf-token))
|
||||
(liked (get item "liked_by_me"))
|
||||
@@ -248,50 +248,50 @@
|
||||
(ainbox (or (get item "author_inbox") ""))
|
||||
(target (str "#interactions-" safe-id)))
|
||||
(div :id (str "interactions-" safe-id)
|
||||
(~federation-interaction-buttons
|
||||
:like (~federation-like-form
|
||||
(~social/interaction-buttons
|
||||
:like (~social/like-form
|
||||
:action (url-for (if liked "social.unlike" "social.like"))
|
||||
:target target :oid oid :ainbox ainbox :csrf csrf
|
||||
:cls (str "flex items-center gap-1 " (if liked "text-red-500 hover:text-red-600" "hover:text-red-500"))
|
||||
:icon (if liked "\u2665" "\u2661") :count (str lcount))
|
||||
:boost (~federation-boost-form
|
||||
:boost (~social/boost-form
|
||||
:action (url-for (if boosted-me "social.unboost" "social.boost"))
|
||||
:target target :oid oid :ainbox ainbox :csrf csrf
|
||||
:cls (str "flex items-center gap-1 " (if boosted-me "text-green-600 hover:text-green-700" "hover:text-green-600"))
|
||||
:count (str bcount))
|
||||
:reply (when oid
|
||||
(~federation-reply-link
|
||||
(~social/reply-link
|
||||
:url (url-for "social.defpage_compose_form" :reply-to oid))))))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Assembled timeline items — replaces Python _timeline_items_sx
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~federation-timeline-items (&key items timeline-type actor next-url)
|
||||
(defcomp ~social/timeline-items (&key (items :as list) (timeline-type :as string) actor (next-url :as string?))
|
||||
(<>
|
||||
(map (lambda (item)
|
||||
(~federation-post-card-from-data :item item :actor actor))
|
||||
(~social/post-card-from-data :item item :actor actor))
|
||||
items)
|
||||
(when next-url
|
||||
(~federation-scroll-sentinel :url next-url))))
|
||||
(~social/scroll-sentinel :url next-url))))
|
||||
|
||||
;; Assembled timeline content — replaces Python _timeline_content_sx
|
||||
(defcomp ~federation-timeline-content (&key items timeline-type actor)
|
||||
(defcomp ~social/timeline-content (&key (items :as list) (timeline-type :as string) actor)
|
||||
(let* ((label (if (= timeline-type "home") "Home" "Public")))
|
||||
(~federation-timeline-page
|
||||
(~social/timeline-page
|
||||
:label label
|
||||
:compose (when actor
|
||||
(~federation-compose-button :url (url-for "social.defpage_compose_form")))
|
||||
:timeline (~federation-timeline-items
|
||||
(~social/compose-button :url (url-for "social.defpage_compose_form")))
|
||||
:timeline (~social/timeline-items
|
||||
:items items :timeline-type timeline-type :actor actor
|
||||
:next-url (when (not (empty? items))
|
||||
(url-for (str "social." timeline-type "_timeline_page")
|
||||
:before (get (last items) "before_cursor")))))))
|
||||
|
||||
;; Assembled compose content — replaces Python _compose_content_sx
|
||||
(defcomp ~federation-compose-content (&key reply-to)
|
||||
(~federation-compose-form
|
||||
(defcomp ~social/compose-content (&key (reply-to :as string?))
|
||||
(~social/compose-form
|
||||
:action (url-for "social.compose_submit")
|
||||
:csrf (csrf-token)
|
||||
:reply (when reply-to
|
||||
(~federation-compose-reply :reply-to (escape reply-to)))))
|
||||
(~social/compose-reply :reply-to (escape reply-to)))))
|
||||
|
||||
@@ -6,7 +6,7 @@
|
||||
:auth :login
|
||||
:layout :social
|
||||
:data (service "federation-page" "home-timeline-data")
|
||||
:content (~federation-timeline-content
|
||||
:content (~social/timeline-content
|
||||
:items items
|
||||
:timeline-type timeline-type
|
||||
:actor actor))
|
||||
@@ -16,7 +16,7 @@
|
||||
:auth :public
|
||||
:layout :social
|
||||
:data (service "federation-page" "public-timeline-data")
|
||||
:content (~federation-timeline-content
|
||||
:content (~social/timeline-content
|
||||
:items items
|
||||
:timeline-type timeline-type
|
||||
:actor actor))
|
||||
@@ -26,7 +26,7 @@
|
||||
:auth :login
|
||||
:layout :social
|
||||
:data (service "federation-page" "compose-data")
|
||||
:content (~federation-compose-content
|
||||
:content (~social/compose-content
|
||||
:reply-to reply-to))
|
||||
|
||||
(defpage search
|
||||
@@ -34,7 +34,7 @@
|
||||
:auth :public
|
||||
:layout :social
|
||||
:data (service "federation-page" "search-data")
|
||||
:content (~federation-search-content
|
||||
:content (~search/content
|
||||
:query query
|
||||
:actors actors
|
||||
:total total
|
||||
@@ -46,7 +46,7 @@
|
||||
:auth :login
|
||||
:layout :social
|
||||
:data (service "federation-page" "following-data")
|
||||
:content (~federation-following-content
|
||||
:content (~search/following-content
|
||||
:actors actors
|
||||
:total total
|
||||
:actor actor))
|
||||
@@ -56,7 +56,7 @@
|
||||
:auth :login
|
||||
:layout :social
|
||||
:data (service "federation-page" "followers-data")
|
||||
:content (~federation-followers-content
|
||||
:content (~search/followers-content
|
||||
:actors actors
|
||||
:total total
|
||||
:followed-urls followed-urls
|
||||
@@ -67,7 +67,7 @@
|
||||
:auth :public
|
||||
:layout :social
|
||||
:data (service "federation-page" "actor-timeline-data" :id id)
|
||||
:content (~federation-actor-timeline-content
|
||||
:content (~profile/actor-timeline-content
|
||||
:remote-actor remote-actor
|
||||
:items items
|
||||
:is-following is-following
|
||||
@@ -78,5 +78,5 @@
|
||||
:auth :login
|
||||
:layout :social
|
||||
:data (service "federation-page" "notifications-data")
|
||||
:content (~federation-notifications-content
|
||||
:content (~notifications/content
|
||||
:notifications notifications))
|
||||
|
||||
@@ -27,7 +27,7 @@ async def _social_page(ctx: dict, actor, *, content: str,
|
||||
from markupsafe import escape
|
||||
|
||||
env = {"actor": _serialize_actor(actor) if actor else None}
|
||||
header_rows = await render_to_sx_with_env("social-layout-full", env)
|
||||
header_rows = await render_to_sx_with_env("layouts/social-layout-full", env)
|
||||
return await full_page_sx(ctx, header_rows=header_rows, content=content,
|
||||
meta_html=meta_html or f'<title>{escape(title)}</title>')
|
||||
|
||||
|
||||
278
hosts/javascript/bootstrap.py
Normal file
278
hosts/javascript/bootstrap.py
Normal file
@@ -0,0 +1,278 @@
|
||||
#!/usr/bin/env python3
|
||||
"""
|
||||
Bootstrap compiler: js.sx (self-hosting SX-to-JS translator) → sx-browser.js.
|
||||
|
||||
This is the canonical JS bootstrapper. js.sx is loaded into the Python evaluator,
|
||||
which uses it to translate the .sx spec files into JavaScript. Platform code
|
||||
(types, primitives, DOM interface) comes from platform_js.py.
|
||||
|
||||
Usage:
|
||||
python run_js_sx.py # stdout
|
||||
python run_js_sx.py -o shared/static/scripts/sx-browser.js # file
|
||||
"""
|
||||
from __future__ import annotations
|
||||
|
||||
import os
|
||||
import sys
|
||||
|
||||
_HERE = os.path.dirname(os.path.abspath(__file__))
|
||||
_PROJECT = os.path.abspath(os.path.join(_HERE, "..", ".."))
|
||||
if _PROJECT not in sys.path:
|
||||
sys.path.insert(0, _PROJECT)
|
||||
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.types import Symbol
|
||||
from hosts.javascript.platform import (
|
||||
extract_defines,
|
||||
ADAPTER_FILES, ADAPTER_DEPS, SPEC_MODULES, SPEC_MODULE_ORDER, EXTENSION_NAMES,
|
||||
PREAMBLE, PLATFORM_JS_PRE, PLATFORM_JS_POST,
|
||||
PRIMITIVES_JS_MODULES, _ALL_JS_MODULES, _assemble_primitives_js,
|
||||
PLATFORM_DEPS_JS, PLATFORM_PARSER_JS, PLATFORM_DOM_JS,
|
||||
PLATFORM_ENGINE_PURE_JS, PLATFORM_ORCHESTRATION_JS, PLATFORM_BOOT_JS,
|
||||
PLATFORM_CEK_JS, CEK_FIXUPS_JS,
|
||||
CONTINUATIONS_JS, ASYNC_IO_JS,
|
||||
fixups_js, public_api_js, EPILOGUE,
|
||||
)
|
||||
|
||||
|
||||
_js_sx_env = None # cached
|
||||
|
||||
|
||||
def load_js_sx() -> dict:
|
||||
"""Load js.sx into an evaluator environment and return it."""
|
||||
global _js_sx_env
|
||||
if _js_sx_env is not None:
|
||||
return _js_sx_env
|
||||
|
||||
js_sx_path = os.path.join(_HERE, "transpiler.sx")
|
||||
with open(js_sx_path) as f:
|
||||
source = f.read()
|
||||
|
||||
exprs = parse_all(source)
|
||||
|
||||
from shared.sx.ref.sx_ref import evaluate, make_env
|
||||
|
||||
env = make_env()
|
||||
for expr in exprs:
|
||||
evaluate(expr, env)
|
||||
|
||||
_js_sx_env = env
|
||||
return env
|
||||
|
||||
|
||||
def compile_ref_to_js(
|
||||
adapters: list[str] | None = None,
|
||||
modules: list[str] | None = None,
|
||||
extensions: list[str] | None = None,
|
||||
spec_modules: list[str] | None = None,
|
||||
) -> str:
|
||||
"""Compile SX spec files to JavaScript using js.sx.
|
||||
|
||||
Args:
|
||||
adapters: List of adapter names to include. None = all.
|
||||
modules: List of primitive module names. None = all.
|
||||
extensions: List of extensions (continuations). None = none.
|
||||
spec_modules: List of spec modules (deps, router, signals). None = auto.
|
||||
"""
|
||||
from datetime import datetime, timezone
|
||||
from shared.sx.ref.sx_ref import evaluate
|
||||
|
||||
ref_dir = os.path.join(_PROJECT, "shared", "sx", "ref")
|
||||
# Source directories: core spec, web framework, and legacy ref (for bootstrapper tools)
|
||||
_source_dirs = [
|
||||
os.path.join(_PROJECT, "spec"), # Core spec
|
||||
os.path.join(_PROJECT, "web"), # Web framework
|
||||
ref_dir, # Legacy location (fallback)
|
||||
]
|
||||
env = load_js_sx()
|
||||
|
||||
# Resolve adapter set
|
||||
if adapters is None:
|
||||
adapter_set = set(ADAPTER_FILES.keys())
|
||||
else:
|
||||
adapter_set = set()
|
||||
for a in adapters:
|
||||
if a not in ADAPTER_FILES:
|
||||
raise ValueError(f"Unknown adapter: {a!r}. Valid: {', '.join(ADAPTER_FILES)}")
|
||||
adapter_set.add(a)
|
||||
for dep in ADAPTER_DEPS.get(a, []):
|
||||
adapter_set.add(dep)
|
||||
|
||||
# Resolve spec modules
|
||||
spec_mod_set = set()
|
||||
if spec_modules:
|
||||
for sm in spec_modules:
|
||||
if sm not in SPEC_MODULES:
|
||||
raise ValueError(f"Unknown spec module: {sm!r}. Valid: {', '.join(SPEC_MODULES)}")
|
||||
spec_mod_set.add(sm)
|
||||
if "dom" in adapter_set and "signals" in SPEC_MODULES:
|
||||
spec_mod_set.add("signals")
|
||||
if "boot" in adapter_set:
|
||||
spec_mod_set.add("router")
|
||||
spec_mod_set.add("deps")
|
||||
if "page-helpers" in SPEC_MODULES:
|
||||
spec_mod_set.add("page-helpers")
|
||||
# CEK is always included (part of evaluator.sx core file)
|
||||
has_cek = True
|
||||
has_deps = "deps" in spec_mod_set
|
||||
has_router = "router" in spec_mod_set
|
||||
has_page_helpers = "page-helpers" in spec_mod_set
|
||||
|
||||
# Resolve extensions
|
||||
ext_set = set()
|
||||
if extensions:
|
||||
for e in extensions:
|
||||
if e not in EXTENSION_NAMES:
|
||||
raise ValueError(f"Unknown extension: {e!r}. Valid: {', '.join(EXTENSION_NAMES)}")
|
||||
ext_set.add(e)
|
||||
has_continuations = "continuations" in ext_set
|
||||
|
||||
# Build file list: core evaluator + adapters + spec modules
|
||||
# evaluator.sx = merged frames + eval utilities + CEK machine
|
||||
sx_files = [
|
||||
("evaluator.sx", "evaluator (frames + eval + CEK)"),
|
||||
("render.sx", "render (core)"),
|
||||
]
|
||||
for name in ("parser", "html", "sx", "dom", "engine", "orchestration", "boot"):
|
||||
if name in adapter_set:
|
||||
sx_files.append(ADAPTER_FILES[name])
|
||||
# Use explicit ordering for spec modules (respects dependencies)
|
||||
for name in SPEC_MODULE_ORDER:
|
||||
if name in spec_mod_set:
|
||||
sx_files.append(SPEC_MODULES[name])
|
||||
# Any spec modules not in the order list (future-proofing)
|
||||
for name in sorted(spec_mod_set):
|
||||
if name not in SPEC_MODULE_ORDER:
|
||||
sx_files.append(SPEC_MODULES[name])
|
||||
|
||||
has_html = "html" in adapter_set
|
||||
has_sx = "sx" in adapter_set
|
||||
has_dom = "dom" in adapter_set
|
||||
has_engine = "engine" in adapter_set
|
||||
has_orch = "orchestration" in adapter_set
|
||||
has_boot = "boot" in adapter_set
|
||||
has_parser = "parser" in adapter_set
|
||||
has_signals = "signals" in spec_mod_set
|
||||
adapter_label = "+".join(sorted(adapter_set)) if adapter_set else "core-only"
|
||||
|
||||
# Platform JS blocks keyed by adapter name
|
||||
adapter_platform = {
|
||||
"parser": PLATFORM_PARSER_JS,
|
||||
"dom": PLATFORM_DOM_JS,
|
||||
"engine": PLATFORM_ENGINE_PURE_JS,
|
||||
"orchestration": PLATFORM_ORCHESTRATION_JS,
|
||||
"boot": PLATFORM_BOOT_JS,
|
||||
}
|
||||
|
||||
# Determine primitive modules
|
||||
prim_modules = None
|
||||
if modules is not None:
|
||||
prim_modules = [m for m in _ALL_JS_MODULES if m.startswith("core.")]
|
||||
for m in modules:
|
||||
if m not in prim_modules:
|
||||
if m not in PRIMITIVES_JS_MODULES:
|
||||
raise ValueError(f"Unknown module: {m!r}. Valid: {', '.join(PRIMITIVES_JS_MODULES)}")
|
||||
prim_modules.append(m)
|
||||
|
||||
# Build output
|
||||
parts = []
|
||||
parts.append(PREAMBLE)
|
||||
parts.append(PLATFORM_JS_PRE)
|
||||
parts.append('\n // =========================================================================')
|
||||
parts.append(' // Primitives')
|
||||
parts.append(' // =========================================================================\n')
|
||||
parts.append(' var PRIMITIVES = {};')
|
||||
parts.append(_assemble_primitives_js(prim_modules))
|
||||
parts.append(PLATFORM_JS_POST)
|
||||
|
||||
if has_deps:
|
||||
parts.append(PLATFORM_DEPS_JS)
|
||||
|
||||
if has_parser:
|
||||
parts.append(adapter_platform["parser"])
|
||||
|
||||
# CEK platform aliases must come before transpiled cek.sx (which uses them)
|
||||
if has_cek:
|
||||
parts.append(PLATFORM_CEK_JS)
|
||||
|
||||
# Translate each spec file using js.sx
|
||||
def _find_sx(filename):
|
||||
for d in _source_dirs:
|
||||
p = os.path.join(d, filename)
|
||||
if os.path.exists(p):
|
||||
return p
|
||||
return None
|
||||
|
||||
for filename, label in sx_files:
|
||||
filepath = _find_sx(filename)
|
||||
if not filepath:
|
||||
continue
|
||||
with open(filepath) as f:
|
||||
src = f.read()
|
||||
defines = extract_defines(src)
|
||||
|
||||
sx_defines = [[name, expr] for name, expr in defines]
|
||||
|
||||
parts.append(f"\n // === Transpiled from {label} ===\n")
|
||||
env["_defines"] = sx_defines
|
||||
result = evaluate(
|
||||
[Symbol("js-translate-file"), Symbol("_defines")],
|
||||
env,
|
||||
)
|
||||
parts.append(result)
|
||||
|
||||
# Platform JS for selected adapters
|
||||
if not has_dom:
|
||||
parts.append("\n var _hasDom = false;\n")
|
||||
|
||||
# CEK fixups + general fixups BEFORE boot (boot hydrates islands that need these)
|
||||
parts.append(fixups_js(has_html, has_sx, has_dom, has_signals, has_deps, has_page_helpers))
|
||||
if has_cek:
|
||||
parts.append(CEK_FIXUPS_JS)
|
||||
|
||||
for name in ("dom", "engine", "orchestration", "boot"):
|
||||
if name in adapter_set and name in adapter_platform:
|
||||
parts.append(adapter_platform[name])
|
||||
# CONTINUATIONS_JS is the tree-walk shift/reset extension.
|
||||
# With CEK as sole evaluator, continuations are handled natively by
|
||||
# cek.sx (step-sf-reset, step-sf-shift). Skip the tree-walk extension.
|
||||
# if has_continuations:
|
||||
# parts.append(CONTINUATIONS_JS)
|
||||
if has_dom:
|
||||
parts.append(ASYNC_IO_JS)
|
||||
parts.append(public_api_js(has_html, has_sx, has_dom, has_engine, has_orch, has_boot, has_parser, adapter_label, has_deps, has_router, has_signals, has_page_helpers, has_cek))
|
||||
parts.append(EPILOGUE)
|
||||
|
||||
build_ts = datetime.now(timezone.utc).strftime("%Y-%m-%dT%H:%M:%SZ")
|
||||
return "\n".join(parts).replace("BUILD_TIMESTAMP", build_ts)
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
import argparse
|
||||
p = argparse.ArgumentParser(description="Bootstrap-compile SX reference spec to JavaScript via js.sx")
|
||||
p.add_argument("--adapters", "-a",
|
||||
help="Comma-separated adapter list (html,sx,dom,engine). Default: all")
|
||||
p.add_argument("--modules", "-m",
|
||||
help="Comma-separated primitive modules (core.* always included). Default: all")
|
||||
p.add_argument("--extensions",
|
||||
help="Comma-separated extensions (continuations). Default: none.")
|
||||
p.add_argument("--spec-modules",
|
||||
help="Comma-separated spec modules (deps). Default: none.")
|
||||
default_output = os.path.join(_HERE, "..", "..", "static", "scripts", "sx-browser.js")
|
||||
p.add_argument("--output", "-o", default=default_output,
|
||||
help="Output file (default: shared/static/scripts/sx-browser.js)")
|
||||
args = p.parse_args()
|
||||
|
||||
adapters = args.adapters.split(",") if args.adapters else None
|
||||
modules = args.modules.split(",") if args.modules else None
|
||||
extensions = args.extensions.split(",") if args.extensions else None
|
||||
spec_modules = args.spec_modules.split(",") if args.spec_modules else None
|
||||
js = compile_ref_to_js(adapters, modules, extensions, spec_modules)
|
||||
|
||||
with open(args.output, "w") as f:
|
||||
f.write(js)
|
||||
included = ", ".join(adapters) if adapters else "all"
|
||||
mods = ", ".join(modules) if modules else "all"
|
||||
ext_label = ", ".join(extensions) if extensions else "none"
|
||||
print(f"Wrote {args.output} ({len(js)} bytes, adapters: {included}, modules: {mods}, extensions: {ext_label})",
|
||||
file=sys.stderr)
|
||||
66
hosts/javascript/cli.py
Normal file
66
hosts/javascript/cli.py
Normal file
@@ -0,0 +1,66 @@
|
||||
#!/usr/bin/env python3
|
||||
"""
|
||||
Bootstrap compiler: reference SX evaluator → JavaScript.
|
||||
|
||||
This is now a thin shim that delegates to run_js_sx.py (the self-hosting
|
||||
bootstrapper). The hand-written JSEmitter has been replaced by js.sx.
|
||||
|
||||
Usage:
|
||||
python bootstrap_js.py
|
||||
"""
|
||||
from __future__ import annotations
|
||||
|
||||
import os
|
||||
import sys
|
||||
|
||||
_HERE = os.path.dirname(os.path.abspath(__file__))
|
||||
_PROJECT = os.path.abspath(os.path.join(_HERE, "..", "..", ".."))
|
||||
if _PROJECT not in sys.path:
|
||||
sys.path.insert(0, _PROJECT)
|
||||
|
||||
# Re-export everything that consumers import from this module.
|
||||
# Canonical source is now run_js_sx.py (self-hosting via js.sx) and platform_js.py.
|
||||
import sys, os
|
||||
sys.path.insert(0, os.path.abspath(os.path.join(os.path.dirname(__file__), "..", "..")))
|
||||
from hosts.javascript.bootstrap import compile_ref_to_js, load_js_sx # noqa: F401
|
||||
from hosts.javascript.platform import ( # noqa: F401
|
||||
extract_defines,
|
||||
ADAPTER_FILES, ADAPTER_DEPS, SPEC_MODULES, EXTENSION_NAMES,
|
||||
PREAMBLE, PLATFORM_JS_PRE, PLATFORM_JS_POST,
|
||||
PRIMITIVES_JS_MODULES, _ALL_JS_MODULES, _assemble_primitives_js,
|
||||
PLATFORM_DEPS_JS, PLATFORM_PARSER_JS, PLATFORM_DOM_JS,
|
||||
PLATFORM_ENGINE_PURE_JS, PLATFORM_ORCHESTRATION_JS, PLATFORM_BOOT_JS,
|
||||
CONTINUATIONS_JS, ASYNC_IO_JS,
|
||||
fixups_js, public_api_js, EPILOGUE,
|
||||
)
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
import argparse
|
||||
p = argparse.ArgumentParser(description="Bootstrap-compile SX reference spec to JavaScript")
|
||||
p.add_argument("--adapters", "-a",
|
||||
help="Comma-separated adapter list (html,sx,dom,engine). Default: all")
|
||||
p.add_argument("--modules", "-m",
|
||||
help="Comma-separated primitive modules (core.* always included). Default: all")
|
||||
p.add_argument("--extensions",
|
||||
help="Comma-separated extensions (continuations). Default: none.")
|
||||
p.add_argument("--spec-modules",
|
||||
help="Comma-separated spec modules (deps). Default: none.")
|
||||
default_output = os.path.join(_HERE, "..", "..", "shared", "static", "scripts", "sx-browser.js")
|
||||
p.add_argument("--output", "-o", default=default_output,
|
||||
help="Output file (default: shared/static/scripts/sx-browser.js)")
|
||||
args = p.parse_args()
|
||||
|
||||
adapters = args.adapters.split(",") if args.adapters else None
|
||||
modules = args.modules.split(",") if args.modules else None
|
||||
extensions = args.extensions.split(",") if args.extensions else None
|
||||
spec_modules = args.spec_modules.split(",") if args.spec_modules else None
|
||||
js = compile_ref_to_js(adapters, modules, extensions, spec_modules)
|
||||
|
||||
with open(args.output, "w") as f:
|
||||
f.write(js)
|
||||
included = ", ".join(adapters) if adapters else "all"
|
||||
mods = ", ".join(modules) if modules else "all"
|
||||
ext_label = ", ".join(extensions) if extensions else "none"
|
||||
print(f"Wrote {args.output} ({len(js)} bytes, adapters: {included}, modules: {mods}, extensions: {ext_label})",
|
||||
file=sys.stderr)
|
||||
3428
hosts/javascript/platform.py
Normal file
3428
hosts/javascript/platform.py
Normal file
File diff suppressed because it is too large
Load Diff
320
hosts/javascript/run_tests.js
Normal file
320
hosts/javascript/run_tests.js
Normal file
@@ -0,0 +1,320 @@
|
||||
#!/usr/bin/env node
|
||||
/**
|
||||
* Run SX spec tests in Node.js using the bootstrapped evaluator.
|
||||
*
|
||||
* Usage:
|
||||
* node hosts/javascript/run_tests.js # all spec tests
|
||||
* node hosts/javascript/run_tests.js test-primitives # specific test
|
||||
*/
|
||||
const fs = require("fs");
|
||||
const path = require("path");
|
||||
|
||||
// Provide globals that sx-browser.js expects
|
||||
global.window = global;
|
||||
global.addEventListener = () => {};
|
||||
global.self = global;
|
||||
global.document = {
|
||||
createElement: () => ({ style: {}, setAttribute: () => {}, appendChild: () => {}, children: [] }),
|
||||
createDocumentFragment: () => ({ appendChild: () => {}, children: [], childNodes: [] }),
|
||||
head: { appendChild: () => {} },
|
||||
body: { appendChild: () => {} },
|
||||
querySelector: () => null,
|
||||
querySelectorAll: () => [],
|
||||
createTextNode: (s) => ({ textContent: s }),
|
||||
addEventListener: () => {},
|
||||
};
|
||||
global.localStorage = { getItem: () => null, setItem: () => {}, removeItem: () => {} };
|
||||
global.CustomEvent = class CustomEvent { constructor(n, o) { this.type = n; this.detail = (o||{}).detail||{}; } };
|
||||
global.MutationObserver = class { observe() {} disconnect() {} };
|
||||
global.requestIdleCallback = (fn) => setTimeout(fn, 0);
|
||||
global.matchMedia = () => ({ matches: false });
|
||||
global.navigator = { serviceWorker: { register: () => Promise.resolve() } };
|
||||
global.location = { href: "", pathname: "/", hostname: "localhost" };
|
||||
global.history = { pushState: () => {}, replaceState: () => {} };
|
||||
global.fetch = () => Promise.resolve({ ok: true, text: () => Promise.resolve("") });
|
||||
global.setTimeout = setTimeout;
|
||||
global.clearTimeout = clearTimeout;
|
||||
global.console = console;
|
||||
|
||||
// Load the bootstrapped evaluator
|
||||
// Use --full flag to load a full-spec build (if available)
|
||||
const fullBuild = process.argv.includes("--full");
|
||||
const jsPath = fullBuild
|
||||
? path.join(__dirname, "..", "..", "shared", "static", "scripts", "sx-full-test.js")
|
||||
: path.join(__dirname, "..", "..", "shared", "static", "scripts", "sx-browser.js");
|
||||
if (fullBuild && !fs.existsSync(jsPath)) {
|
||||
console.error("Full test build not found. Run: python3 hosts/javascript/cli.py --extensions continuations --spec-modules types --output shared/static/scripts/sx-full-test.js");
|
||||
process.exit(1);
|
||||
}
|
||||
const Sx = require(jsPath);
|
||||
if (!Sx || !Sx.parse) {
|
||||
console.error("Failed to load Sx evaluator");
|
||||
process.exit(1);
|
||||
}
|
||||
|
||||
// Reset render mode — boot process may have set it to true
|
||||
if (Sx.setRenderActive) Sx.setRenderActive(false);
|
||||
|
||||
// Test infrastructure
|
||||
let passCount = 0;
|
||||
let failCount = 0;
|
||||
const suiteStack = [];
|
||||
|
||||
// Build env with all primitives + spec functions
|
||||
const env = Sx.getEnv ? Object.assign({}, Sx.getEnv()) : {};
|
||||
|
||||
// Additional test helpers needed by spec tests
|
||||
env["sx-parse"] = function(s) { return Sx.parse(s); };
|
||||
env["sx-parse-one"] = function(s) { const r = Sx.parse(s); return r && r.length > 0 ? r[0] : null; };
|
||||
env["test-env"] = function() { return Sx.getEnv ? Object.assign({}, Sx.getEnv()) : {}; };
|
||||
env["cek-eval"] = function(s) {
|
||||
const parsed = Sx.parse(s);
|
||||
if (!parsed || parsed.length === 0) return null;
|
||||
return Sx.eval(parsed[0], Sx.getEnv ? Object.assign({}, Sx.getEnv()) : {});
|
||||
};
|
||||
env["eval-expr-cek"] = function(expr, e) { return Sx.eval(expr, e || env); };
|
||||
env["env-get"] = function(e, k) { return e && e[k] !== undefined ? e[k] : null; };
|
||||
env["env-has?"] = function(e, k) { return e && k in e; };
|
||||
env["env-bind!"] = function(e, k, v) { if (e) e[k] = v; return v; };
|
||||
env["env-set!"] = function(e, k, v) { if (e) e[k] = v; return v; };
|
||||
env["env-extend"] = function(e) { return Object.create(e); };
|
||||
env["env-merge"] = function(a, b) { return Object.assign({}, a, b); };
|
||||
|
||||
// Missing primitives referenced by tests
|
||||
env["upcase"] = function(s) { return s.toUpperCase(); };
|
||||
env["downcase"] = function(s) { return s.toLowerCase(); };
|
||||
env["make-keyword"] = function(name) { return new Sx.Keyword(name); };
|
||||
env["string-length"] = function(s) { return s.length; };
|
||||
env["dict-get"] = function(d, k) { return d && d[k] !== undefined ? d[k] : null; };
|
||||
env["apply"] = function(f) {
|
||||
var args = Array.prototype.slice.call(arguments, 1);
|
||||
var lastArg = args.pop();
|
||||
if (Array.isArray(lastArg)) args = args.concat(lastArg);
|
||||
return f.apply(null, args);
|
||||
};
|
||||
|
||||
// Deep equality
|
||||
function deepEqual(a, b) {
|
||||
if (a === b) return true;
|
||||
if (a == null || b == null) return a == b;
|
||||
if (typeof a !== typeof b) return false;
|
||||
if (Array.isArray(a) && Array.isArray(b)) {
|
||||
if (a.length !== b.length) return false;
|
||||
return a.every((v, i) => deepEqual(v, b[i]));
|
||||
}
|
||||
if (typeof a === "object") {
|
||||
const ka = Object.keys(a).filter(k => k !== "_nil");
|
||||
const kb = Object.keys(b).filter(k => k !== "_nil");
|
||||
if (ka.length !== kb.length) return false;
|
||||
return ka.every(k => deepEqual(a[k], b[k]));
|
||||
}
|
||||
return false;
|
||||
}
|
||||
env["equal?"] = deepEqual;
|
||||
env["identical?"] = function(a, b) { return a === b; };
|
||||
|
||||
// Continuation support
|
||||
env["make-continuation"] = function(fn) {
|
||||
// Continuation must be callable as a function AND have _continuation flag
|
||||
var c = function(v) { return fn(v !== undefined ? v : null); };
|
||||
c._continuation = true;
|
||||
c.fn = fn;
|
||||
c.call = function(v) { return fn(v !== undefined ? v : null); };
|
||||
return c;
|
||||
};
|
||||
env["continuation?"] = function(x) { return x != null && x._continuation === true; };
|
||||
env["continuation-fn"] = function(c) { return c.fn; };
|
||||
|
||||
// Render helpers
|
||||
// render-html: the tests call this with an SX source string, parse it, and render to HTML
|
||||
// IMPORTANT: renderToHtml sets a global _renderMode flag but never resets it.
|
||||
// We must reset it after each call so subsequent eval calls don't go through the render path.
|
||||
env["render-html"] = function(src, e) {
|
||||
var result;
|
||||
if (typeof src === "string") {
|
||||
var parsed = Sx.parse(src);
|
||||
if (!parsed || parsed.length === 0) return "";
|
||||
var expr = parsed.length === 1 ? parsed[0] : [{ name: "do" }].concat(parsed);
|
||||
if (Sx.renderToHtml) {
|
||||
result = Sx.renderToHtml(expr, e || (Sx.getEnv ? Object.assign({}, Sx.getEnv()) : {}));
|
||||
} else {
|
||||
result = Sx.serialize(expr);
|
||||
}
|
||||
} else {
|
||||
if (Sx.renderToHtml) {
|
||||
result = Sx.renderToHtml(src, e || env);
|
||||
} else {
|
||||
result = Sx.serialize(src);
|
||||
}
|
||||
}
|
||||
// Reset render mode so subsequent eval calls don't go through DOM/HTML render path
|
||||
if (Sx.setRenderActive) Sx.setRenderActive(false);
|
||||
return result;
|
||||
};
|
||||
// Also register render-to-html directly
|
||||
env["render-to-html"] = env["render-html"];
|
||||
|
||||
// Type system helpers — available when types module is included
|
||||
|
||||
// test-prim-types: dict of primitive return types for type inference
|
||||
env["test-prim-types"] = function() {
|
||||
return {
|
||||
"+": "number", "-": "number", "*": "number", "/": "number",
|
||||
"mod": "number", "inc": "number", "dec": "number",
|
||||
"abs": "number", "min": "number", "max": "number",
|
||||
"floor": "number", "ceil": "number", "round": "number",
|
||||
"str": "string", "upper": "string", "lower": "string",
|
||||
"trim": "string", "join": "string", "replace": "string",
|
||||
"format": "string", "substr": "string",
|
||||
"=": "boolean", "<": "boolean", ">": "boolean",
|
||||
"<=": "boolean", ">=": "boolean", "!=": "boolean",
|
||||
"not": "boolean", "nil?": "boolean", "empty?": "boolean",
|
||||
"number?": "boolean", "string?": "boolean", "boolean?": "boolean",
|
||||
"list?": "boolean", "dict?": "boolean", "symbol?": "boolean",
|
||||
"keyword?": "boolean", "contains?": "boolean", "has-key?": "boolean",
|
||||
"starts-with?": "boolean", "ends-with?": "boolean",
|
||||
"len": "number", "first": "any", "rest": "list",
|
||||
"last": "any", "nth": "any", "cons": "list",
|
||||
"append": "list", "concat": "list", "reverse": "list",
|
||||
"sort": "list", "slice": "list", "range": "list",
|
||||
"flatten": "list", "keys": "list", "vals": "list",
|
||||
"map-dict": "dict", "assoc": "dict", "dissoc": "dict",
|
||||
"merge": "dict", "dict": "dict",
|
||||
"get": "any", "type-of": "string",
|
||||
};
|
||||
};
|
||||
|
||||
// test-prim-param-types: dict of primitive param type specs
|
||||
env["test-prim-param-types"] = function() {
|
||||
return {
|
||||
"+": {"positional": [["a", "number"]], "rest-type": "number"},
|
||||
"-": {"positional": [["a", "number"]], "rest-type": "number"},
|
||||
"*": {"positional": [["a", "number"]], "rest-type": "number"},
|
||||
"/": {"positional": [["a", "number"]], "rest-type": "number"},
|
||||
"inc": {"positional": [["n", "number"]], "rest-type": null},
|
||||
"dec": {"positional": [["n", "number"]], "rest-type": null},
|
||||
"upper": {"positional": [["s", "string"]], "rest-type": null},
|
||||
"lower": {"positional": [["s", "string"]], "rest-type": null},
|
||||
"keys": {"positional": [["d", "dict"]], "rest-type": null},
|
||||
"vals": {"positional": [["d", "dict"]], "rest-type": null},
|
||||
};
|
||||
};
|
||||
|
||||
// Component type accessors
|
||||
env["component-param-types"] = function(c) {
|
||||
return c && c._paramTypes ? c._paramTypes : null;
|
||||
};
|
||||
env["component-set-param-types!"] = function(c, t) {
|
||||
if (c) c._paramTypes = t;
|
||||
return null;
|
||||
};
|
||||
env["component-params"] = function(c) {
|
||||
return c && c.params ? c.params : null;
|
||||
};
|
||||
env["component-body"] = function(c) {
|
||||
return c && c.body ? c.body : null;
|
||||
};
|
||||
env["component-has-children"] = function(c) {
|
||||
return c && c.has_children ? c.has_children : false;
|
||||
};
|
||||
|
||||
// Platform test functions
|
||||
env["try-call"] = function(thunk) {
|
||||
try {
|
||||
Sx.eval([thunk], env);
|
||||
return { ok: true };
|
||||
} catch (e) {
|
||||
return { ok: false, error: e.message || String(e) };
|
||||
}
|
||||
};
|
||||
|
||||
env["report-pass"] = function(name) {
|
||||
passCount++;
|
||||
const ctx = suiteStack.join(" > ");
|
||||
console.log(` PASS: ${ctx} > ${name}`);
|
||||
return null;
|
||||
};
|
||||
|
||||
env["report-fail"] = function(name, error) {
|
||||
failCount++;
|
||||
const ctx = suiteStack.join(" > ");
|
||||
console.log(` FAIL: ${ctx} > ${name}: ${error}`);
|
||||
return null;
|
||||
};
|
||||
|
||||
env["push-suite"] = function(name) {
|
||||
suiteStack.push(name);
|
||||
console.log(`${" ".repeat(suiteStack.length - 1)}Suite: ${name}`);
|
||||
return null;
|
||||
};
|
||||
|
||||
env["pop-suite"] = function() {
|
||||
suiteStack.pop();
|
||||
return null;
|
||||
};
|
||||
|
||||
// Load test framework
|
||||
const projectDir = path.join(__dirname, "..", "..");
|
||||
const specTests = path.join(projectDir, "spec", "tests");
|
||||
const webTests = path.join(projectDir, "web", "tests");
|
||||
|
||||
const frameworkSrc = fs.readFileSync(path.join(specTests, "test-framework.sx"), "utf8");
|
||||
const frameworkExprs = Sx.parse(frameworkSrc);
|
||||
for (const expr of frameworkExprs) {
|
||||
Sx.eval(expr, env);
|
||||
}
|
||||
|
||||
// Determine which tests to run
|
||||
const args = process.argv.slice(2).filter(a => !a.startsWith("--"));
|
||||
let testFiles = [];
|
||||
|
||||
if (args.length > 0) {
|
||||
// Specific test files
|
||||
for (const arg of args) {
|
||||
const name = arg.endsWith(".sx") ? arg : `${arg}.sx`;
|
||||
const specPath = path.join(specTests, name);
|
||||
const webPath = path.join(webTests, name);
|
||||
if (fs.existsSync(specPath)) testFiles.push(specPath);
|
||||
else if (fs.existsSync(webPath)) testFiles.push(webPath);
|
||||
else console.error(`Test file not found: ${name}`);
|
||||
}
|
||||
} else {
|
||||
// Tests requiring optional modules (only run with --full)
|
||||
const requiresFull = new Set(["test-continuations.sx", "test-types.sx", "test-freeze.sx"]);
|
||||
// All spec tests
|
||||
for (const f of fs.readdirSync(specTests).sort()) {
|
||||
if (f.startsWith("test-") && f.endsWith(".sx") && f !== "test-framework.sx") {
|
||||
if (!fullBuild && requiresFull.has(f)) {
|
||||
console.log(`Skipping ${f} (requires --full)`);
|
||||
continue;
|
||||
}
|
||||
testFiles.push(path.join(specTests, f));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// Run tests
|
||||
for (const testFile of testFiles) {
|
||||
const name = path.basename(testFile);
|
||||
console.log("=" .repeat(60));
|
||||
console.log(`Running ${name}`);
|
||||
console.log("=" .repeat(60));
|
||||
|
||||
try {
|
||||
const src = fs.readFileSync(testFile, "utf8");
|
||||
const exprs = Sx.parse(src);
|
||||
for (const expr of exprs) {
|
||||
Sx.eval(expr, env);
|
||||
}
|
||||
} catch (e) {
|
||||
console.error(`ERROR in ${name}: ${e.message}`);
|
||||
failCount++;
|
||||
}
|
||||
}
|
||||
|
||||
// Summary
|
||||
console.log("=" .repeat(60));
|
||||
console.log(`Results: ${passCount} passed, ${failCount} failed`);
|
||||
console.log("=" .repeat(60));
|
||||
|
||||
process.exit(failCount > 0 ? 1 : 0);
|
||||
1515
hosts/javascript/transpiler.sx
Normal file
1515
hosts/javascript/transpiler.sx
Normal file
File diff suppressed because it is too large
Load Diff
36
hosts/ocaml/bin/debug_set.ml
Normal file
36
hosts/ocaml/bin/debug_set.ml
Normal file
@@ -0,0 +1,36 @@
|
||||
module T = Sx.Sx_types
|
||||
module P = Sx.Sx_parser
|
||||
module R = Sx.Sx_ref
|
||||
open T
|
||||
|
||||
let () =
|
||||
let env = T.make_env () in
|
||||
let eval src =
|
||||
let exprs = P.parse_all src in
|
||||
let result = ref Nil in
|
||||
List.iter (fun e -> result := R.eval_expr e (Env env)) exprs;
|
||||
!result
|
||||
in
|
||||
(* Test 1: basic set! in closure *)
|
||||
let r = eval "(let ((x 0)) (set! x 42) x)" in
|
||||
Printf.printf "basic set!: %s (expect 42)\n%!" (T.inspect r);
|
||||
|
||||
(* Test 2: set! through lambda call *)
|
||||
let r = eval "(let ((x 0)) (let ((f (fn () (set! x 99)))) (f) x))" in
|
||||
Printf.printf "set! via lambda: %s (expect 99)\n%!" (T.inspect r);
|
||||
|
||||
(* Test 3: counter pattern *)
|
||||
let r = eval "(do (define make-counter (fn () (let ((c 0)) (fn () (set! c (+ c 1)) c)))) (let ((counter (make-counter))) (counter) (counter) (counter)))" in
|
||||
Printf.printf "counter: %s (expect 3)\n%!" (T.inspect r);
|
||||
|
||||
(* Test 4: set! in for-each *)
|
||||
let r = eval "(let ((total 0)) (for-each (fn (n) (set! total (+ total n))) (list 1 2 3 4 5)) total)" in
|
||||
Printf.printf "set! in for-each: %s (expect 15)\n%!" (T.inspect r);
|
||||
|
||||
(* Test 5: append! in for-each *)
|
||||
ignore (T.env_bind env "append!" (NativeFn ("append!", fun args ->
|
||||
match args with
|
||||
| [List items; v] -> List (items @ [v])
|
||||
| _ -> raise (Eval_error "append!: expected list and value"))));
|
||||
let r = eval "(let ((log (list))) (for-each (fn (x) (append! log x)) (list 1 2 3)) log)" in
|
||||
Printf.printf "append! in for-each: %s (expect (1 2 3))\n%!" (T.inspect r)
|
||||
3
hosts/ocaml/bin/dune
Normal file
3
hosts/ocaml/bin/dune
Normal file
@@ -0,0 +1,3 @@
|
||||
(executables
|
||||
(names run_tests debug_set sx_server)
|
||||
(libraries sx))
|
||||
1
hosts/ocaml/bin/dune_debug
Normal file
1
hosts/ocaml/bin/dune_debug
Normal file
@@ -0,0 +1 @@
|
||||
(executable (name debug_macro) (libraries sx))
|
||||
701
hosts/ocaml/bin/run_tests.ml
Normal file
701
hosts/ocaml/bin/run_tests.ml
Normal file
@@ -0,0 +1,701 @@
|
||||
(** Test runner — runs the SX spec test suite against the transpiled CEK evaluator.
|
||||
|
||||
Provides the 5 platform functions required by test-framework.sx:
|
||||
try-call, report-pass, report-fail, push-suite, pop-suite
|
||||
|
||||
Plus test helpers: sx-parse, cek-eval, env-*, equal?, etc.
|
||||
|
||||
Usage:
|
||||
dune exec bin/run_tests.exe # foundation + spec tests
|
||||
dune exec bin/run_tests.exe -- test-primitives # specific test
|
||||
dune exec bin/run_tests.exe -- --foundation # foundation only *)
|
||||
|
||||
module Sx_types = Sx.Sx_types
|
||||
module Sx_parser = Sx.Sx_parser
|
||||
module Sx_primitives = Sx.Sx_primitives
|
||||
module Sx_runtime = Sx.Sx_runtime
|
||||
module Sx_ref = Sx.Sx_ref
|
||||
module Sx_render = Sx.Sx_render
|
||||
|
||||
open Sx_types
|
||||
open Sx_parser
|
||||
open Sx_primitives
|
||||
open Sx_runtime
|
||||
open Sx_ref
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Test state *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let pass_count = ref 0
|
||||
let fail_count = ref 0
|
||||
let suite_stack : string list ref = ref []
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Deep equality — SX structural comparison *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let rec deep_equal a b =
|
||||
match a, b with
|
||||
| Nil, Nil -> true
|
||||
| Bool a, Bool b -> a = b
|
||||
| Number a, Number b -> a = b
|
||||
| String a, String b -> a = b
|
||||
| Symbol a, Symbol b -> a = b
|
||||
| Keyword a, Keyword b -> a = b
|
||||
| (List a | ListRef { contents = a }), (List b | ListRef { contents = b }) ->
|
||||
List.length a = List.length b &&
|
||||
List.for_all2 deep_equal a b
|
||||
| Dict a, Dict b ->
|
||||
let ka = Hashtbl.fold (fun k _ acc -> k :: acc) a [] in
|
||||
let kb = Hashtbl.fold (fun k _ acc -> k :: acc) b [] in
|
||||
List.length ka = List.length kb &&
|
||||
List.for_all (fun k ->
|
||||
Hashtbl.mem b k &&
|
||||
deep_equal
|
||||
(match Hashtbl.find_opt a k with Some v -> v | None -> Nil)
|
||||
(match Hashtbl.find_opt b k with Some v -> v | None -> Nil)) ka
|
||||
| Lambda _, Lambda _ -> a == b (* identity *)
|
||||
| NativeFn _, NativeFn _ -> a == b
|
||||
| _ -> false
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Build evaluator environment with test platform functions *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let make_test_env () =
|
||||
let env = Sx_types.make_env () in
|
||||
|
||||
let bind name fn =
|
||||
ignore (Sx_types.env_bind env name (NativeFn (name, fn)))
|
||||
in
|
||||
|
||||
(* --- 5 platform functions required by test-framework.sx --- *)
|
||||
|
||||
bind "try-call" (fun args ->
|
||||
match args with
|
||||
| [thunk] ->
|
||||
(try
|
||||
(* Call the thunk: it's a lambda with no params *)
|
||||
let result = eval_expr (List [thunk]) (Env env) in
|
||||
ignore result;
|
||||
let d = Hashtbl.create 2 in
|
||||
Hashtbl.replace d "ok" (Bool true);
|
||||
Dict d
|
||||
with
|
||||
| Eval_error msg ->
|
||||
let d = Hashtbl.create 2 in
|
||||
Hashtbl.replace d "ok" (Bool false);
|
||||
Hashtbl.replace d "error" (String msg);
|
||||
Dict d
|
||||
| exn ->
|
||||
let d = Hashtbl.create 2 in
|
||||
Hashtbl.replace d "ok" (Bool false);
|
||||
Hashtbl.replace d "error" (String (Printexc.to_string exn));
|
||||
Dict d)
|
||||
| _ -> raise (Eval_error "try-call: expected 1 arg"));
|
||||
|
||||
bind "report-pass" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
incr pass_count;
|
||||
let ctx = String.concat " > " (List.rev !suite_stack) in
|
||||
Printf.printf " PASS: %s > %s\n%!" ctx name;
|
||||
Nil
|
||||
| [v] ->
|
||||
incr pass_count;
|
||||
let ctx = String.concat " > " (List.rev !suite_stack) in
|
||||
Printf.printf " PASS: %s > %s\n%!" ctx (Sx_types.inspect v);
|
||||
Nil
|
||||
| _ -> raise (Eval_error "report-pass: expected 1 arg"));
|
||||
|
||||
bind "report-fail" (fun args ->
|
||||
match args with
|
||||
| [String name; String error] ->
|
||||
incr fail_count;
|
||||
let ctx = String.concat " > " (List.rev !suite_stack) in
|
||||
Printf.printf " FAIL: %s > %s: %s\n%!" ctx name error;
|
||||
Nil
|
||||
| [name_v; error_v] ->
|
||||
incr fail_count;
|
||||
let ctx = String.concat " > " (List.rev !suite_stack) in
|
||||
Printf.printf " FAIL: %s > %s: %s\n%!" ctx
|
||||
(Sx_types.value_to_string name_v)
|
||||
(Sx_types.value_to_string error_v);
|
||||
Nil
|
||||
| _ -> raise (Eval_error "report-fail: expected 2 args"));
|
||||
|
||||
bind "push-suite" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
suite_stack := name :: !suite_stack;
|
||||
let indent = String.make ((List.length !suite_stack - 1) * 2) ' ' in
|
||||
Printf.printf "%sSuite: %s\n%!" indent name;
|
||||
Nil
|
||||
| [v] ->
|
||||
let name = Sx_types.value_to_string v in
|
||||
suite_stack := name :: !suite_stack;
|
||||
let indent = String.make ((List.length !suite_stack - 1) * 2) ' ' in
|
||||
Printf.printf "%sSuite: %s\n%!" indent name;
|
||||
Nil
|
||||
| _ -> raise (Eval_error "push-suite: expected 1 arg"));
|
||||
|
||||
bind "pop-suite" (fun _args ->
|
||||
suite_stack := (match !suite_stack with _ :: t -> t | [] -> []);
|
||||
Nil);
|
||||
|
||||
(* --- Test helpers --- *)
|
||||
|
||||
bind "sx-parse" (fun args ->
|
||||
match args with
|
||||
| [String s] -> List (parse_all s)
|
||||
| _ -> raise (Eval_error "sx-parse: expected string"));
|
||||
|
||||
bind "sx-parse-one" (fun args ->
|
||||
match args with
|
||||
| [String s] ->
|
||||
let exprs = parse_all s in
|
||||
(match exprs with e :: _ -> e | [] -> Nil)
|
||||
| _ -> raise (Eval_error "sx-parse-one: expected string"));
|
||||
|
||||
bind "cek-eval" (fun args ->
|
||||
match args with
|
||||
| [String s] ->
|
||||
let exprs = parse_all s in
|
||||
(match exprs with
|
||||
| e :: _ -> eval_expr e (Env env)
|
||||
| [] -> Nil)
|
||||
| _ -> raise (Eval_error "cek-eval: expected string"));
|
||||
|
||||
bind "eval-expr-cek" (fun args ->
|
||||
match args with
|
||||
| [expr; e] -> eval_expr expr e
|
||||
| [expr] -> eval_expr expr (Env env)
|
||||
| _ -> raise (Eval_error "eval-expr-cek: expected 1-2 args"));
|
||||
|
||||
bind "test-env" (fun _args -> Env (Sx_types.env_extend env));
|
||||
|
||||
(* --- Environment operations --- *)
|
||||
|
||||
bind "env-get" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k] -> Sx_types.env_get e k
|
||||
| [Env e; Keyword k] -> Sx_types.env_get e k
|
||||
| _ -> raise (Eval_error "env-get: expected env and string"));
|
||||
|
||||
bind "env-has?" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k] -> Bool (Sx_types.env_has e k)
|
||||
| [Env e; Keyword k] -> Bool (Sx_types.env_has e k)
|
||||
| _ -> raise (Eval_error "env-has?: expected env and string"));
|
||||
|
||||
bind "env-bind!" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k; v] -> Sx_types.env_bind e k v
|
||||
| [Env e; Keyword k; v] -> Sx_types.env_bind e k v
|
||||
| _ -> raise (Eval_error "env-bind!: expected env, key, value"));
|
||||
|
||||
bind "env-set!" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k; v] -> Sx_types.env_set e k v
|
||||
| [Env e; Keyword k; v] -> Sx_types.env_set e k v
|
||||
| _ -> raise (Eval_error "env-set!: expected env, key, value"));
|
||||
|
||||
bind "env-extend" (fun args ->
|
||||
match args with
|
||||
| [Env e] -> Env (Sx_types.env_extend e)
|
||||
| _ -> raise (Eval_error "env-extend: expected env"));
|
||||
|
||||
bind "env-merge" (fun args ->
|
||||
match args with
|
||||
| [Env a; Env b] -> Env (Sx_types.env_merge a b)
|
||||
| _ -> raise (Eval_error "env-merge: expected 2 envs"));
|
||||
|
||||
(* --- Equality --- *)
|
||||
|
||||
bind "equal?" (fun args ->
|
||||
match args with
|
||||
| [a; b] -> Bool (deep_equal a b)
|
||||
| _ -> raise (Eval_error "equal?: expected 2 args"));
|
||||
|
||||
bind "identical?" (fun args ->
|
||||
match args with
|
||||
| [a; b] -> Bool (a == b)
|
||||
| _ -> raise (Eval_error "identical?: expected 2 args"));
|
||||
|
||||
(* --- Continuation support --- *)
|
||||
|
||||
bind "make-continuation" (fun args ->
|
||||
match args with
|
||||
| [f] ->
|
||||
let k v = sx_call f [v] in
|
||||
Continuation (k, None)
|
||||
| _ -> raise (Eval_error "make-continuation: expected 1 arg"));
|
||||
|
||||
bind "continuation?" (fun args ->
|
||||
match args with
|
||||
| [Continuation _] -> Bool true
|
||||
| [_] -> Bool false
|
||||
| _ -> raise (Eval_error "continuation?: expected 1 arg"));
|
||||
|
||||
bind "continuation-fn" (fun args ->
|
||||
match args with
|
||||
| [Continuation (f, _)] -> NativeFn ("continuation-fn-result", fun args ->
|
||||
match args with [v] -> f v | _ -> f Nil)
|
||||
| _ -> raise (Eval_error "continuation-fn: expected continuation"));
|
||||
|
||||
(* --- Core builtins used by test framework / test code --- *)
|
||||
|
||||
bind "assert" (fun args ->
|
||||
match args with
|
||||
| [cond] ->
|
||||
if not (sx_truthy cond) then raise (Eval_error "Assertion failed");
|
||||
Bool true
|
||||
| [cond; String msg] ->
|
||||
if not (sx_truthy cond) then raise (Eval_error ("Assertion error: " ^ msg));
|
||||
Bool true
|
||||
| [cond; msg] ->
|
||||
if not (sx_truthy cond) then
|
||||
raise (Eval_error ("Assertion error: " ^ Sx_types.value_to_string msg));
|
||||
Bool true
|
||||
| _ -> raise (Eval_error "assert: expected 1-2 args"));
|
||||
|
||||
bind "append!" (fun args ->
|
||||
match args with
|
||||
| [ListRef r; v] -> r := !r @ [v]; ListRef r (* mutate in place *)
|
||||
| [List items; v] -> List (items @ [v]) (* immutable fallback *)
|
||||
| _ -> raise (Eval_error "append!: expected list and value"));
|
||||
|
||||
(* --- HTML Renderer (from sx_render.ml library module) --- *)
|
||||
Sx.Sx_render.setup_render_env env;
|
||||
|
||||
(* --- Missing primitives referenced by tests --- *)
|
||||
|
||||
bind "upcase" (fun args ->
|
||||
match args with
|
||||
| [String s] -> String (String.uppercase_ascii s)
|
||||
| _ -> raise (Eval_error "upcase: expected string"));
|
||||
|
||||
bind "downcase" (fun args ->
|
||||
match args with
|
||||
| [String s] -> String (String.lowercase_ascii s)
|
||||
| _ -> raise (Eval_error "downcase: expected string"));
|
||||
|
||||
bind "make-keyword" (fun args ->
|
||||
match args with
|
||||
| [String s] -> Keyword s
|
||||
| _ -> raise (Eval_error "make-keyword: expected string"));
|
||||
|
||||
bind "string-length" (fun args ->
|
||||
match args with
|
||||
| [String s] -> Number (float_of_int (String.length s))
|
||||
| _ -> raise (Eval_error "string-length: expected string"));
|
||||
|
||||
bind "dict-get" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k] -> Sx_types.dict_get d k
|
||||
| [Dict d; Keyword k] -> Sx_types.dict_get d k
|
||||
| _ -> raise (Eval_error "dict-get: expected dict and key"));
|
||||
|
||||
bind "apply" (fun args ->
|
||||
match args with
|
||||
| f :: rest ->
|
||||
let all_args = match List.rev rest with
|
||||
| List last :: prefix -> List.rev prefix @ last
|
||||
| _ -> rest
|
||||
in
|
||||
sx_call f all_args
|
||||
| _ -> raise (Eval_error "apply: expected function and args"));
|
||||
|
||||
(* --- Type system helpers (for --full tests) --- *)
|
||||
|
||||
bind "test-prim-types" (fun _args ->
|
||||
let d = Hashtbl.create 40 in
|
||||
List.iter (fun (k, v) -> Hashtbl.replace d k (String v)) [
|
||||
"+", "number"; "-", "number"; "*", "number"; "/", "number";
|
||||
"mod", "number"; "inc", "number"; "dec", "number";
|
||||
"abs", "number"; "min", "number"; "max", "number";
|
||||
"floor", "number"; "ceil", "number"; "round", "number";
|
||||
"str", "string"; "upper", "string"; "lower", "string";
|
||||
"trim", "string"; "join", "string"; "replace", "string";
|
||||
"format", "string"; "substr", "string";
|
||||
"=", "boolean"; "<", "boolean"; ">", "boolean";
|
||||
"<=", "boolean"; ">=", "boolean"; "!=", "boolean";
|
||||
"not", "boolean"; "nil?", "boolean"; "empty?", "boolean";
|
||||
"number?", "boolean"; "string?", "boolean"; "boolean?", "boolean";
|
||||
"list?", "boolean"; "dict?", "boolean"; "symbol?", "boolean";
|
||||
"keyword?", "boolean"; "contains?", "boolean"; "has-key?", "boolean";
|
||||
"starts-with?", "boolean"; "ends-with?", "boolean";
|
||||
"len", "number"; "first", "any"; "rest", "list";
|
||||
"last", "any"; "nth", "any"; "cons", "list";
|
||||
"append", "list"; "concat", "list"; "reverse", "list";
|
||||
"sort", "list"; "slice", "list"; "range", "list";
|
||||
"flatten", "list"; "keys", "list"; "vals", "list";
|
||||
"map-dict", "dict"; "assoc", "dict"; "dissoc", "dict";
|
||||
"merge", "dict"; "dict", "dict";
|
||||
"get", "any"; "type-of", "string";
|
||||
];
|
||||
Dict d);
|
||||
|
||||
bind "test-prim-param-types" (fun _args ->
|
||||
let d = Hashtbl.create 10 in
|
||||
let pos name typ =
|
||||
let d2 = Hashtbl.create 2 in
|
||||
Hashtbl.replace d2 "positional" (List [List [String name; String typ]]);
|
||||
Hashtbl.replace d2 "rest-type" Nil;
|
||||
Dict d2
|
||||
in
|
||||
let pos_rest name typ rt =
|
||||
let d2 = Hashtbl.create 2 in
|
||||
Hashtbl.replace d2 "positional" (List [List [String name; String typ]]);
|
||||
Hashtbl.replace d2 "rest-type" (String rt);
|
||||
Dict d2
|
||||
in
|
||||
Hashtbl.replace d "+" (pos_rest "a" "number" "number");
|
||||
Hashtbl.replace d "-" (pos_rest "a" "number" "number");
|
||||
Hashtbl.replace d "*" (pos_rest "a" "number" "number");
|
||||
Hashtbl.replace d "/" (pos_rest "a" "number" "number");
|
||||
Hashtbl.replace d "inc" (pos "n" "number");
|
||||
Hashtbl.replace d "dec" (pos "n" "number");
|
||||
Hashtbl.replace d "upper" (pos "s" "string");
|
||||
Hashtbl.replace d "lower" (pos "s" "string");
|
||||
Hashtbl.replace d "keys" (pos "d" "dict");
|
||||
Hashtbl.replace d "vals" (pos "d" "dict");
|
||||
Dict d);
|
||||
|
||||
(* --- Component accessors --- *)
|
||||
|
||||
bind "component-param-types" (fun _args -> Nil);
|
||||
|
||||
bind "component-set-param-types!" (fun _args -> Nil);
|
||||
|
||||
bind "component-params" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> List (List.map (fun s -> String s) c.c_params)
|
||||
| _ -> Nil);
|
||||
|
||||
bind "component-body" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> c.c_body
|
||||
| _ -> Nil);
|
||||
|
||||
bind "component-has-children" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> Bool c.c_has_children
|
||||
| _ -> Bool false);
|
||||
|
||||
bind "component-affinity" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> String c.c_affinity
|
||||
| _ -> String "auto");
|
||||
|
||||
(* --- Parser test helpers --- *)
|
||||
|
||||
bind "keyword-name" (fun args ->
|
||||
match args with
|
||||
| [Keyword k] -> String k
|
||||
| _ -> raise (Eval_error "keyword-name: expected keyword"));
|
||||
|
||||
bind "symbol-name" (fun args ->
|
||||
match args with
|
||||
| [Symbol s] -> String s
|
||||
| _ -> raise (Eval_error "symbol-name: expected symbol"));
|
||||
|
||||
bind "sx-serialize" (fun args ->
|
||||
match args with
|
||||
| [v] -> String (Sx_types.inspect v)
|
||||
| _ -> raise (Eval_error "sx-serialize: expected 1 arg"));
|
||||
|
||||
(* --- make-symbol --- *)
|
||||
|
||||
bind "make-symbol" (fun args ->
|
||||
match args with
|
||||
| [String s] -> Symbol s
|
||||
| [v] -> Symbol (Sx_types.value_to_string v)
|
||||
| _ -> raise (Eval_error "make-symbol: expected 1 arg"));
|
||||
|
||||
(* --- CEK stepping / introspection --- *)
|
||||
|
||||
bind "make-cek-state" (fun args ->
|
||||
match args with
|
||||
| [ctrl; env'; kont] -> Sx_ref.make_cek_state ctrl env' kont
|
||||
| _ -> raise (Eval_error "make-cek-state: expected 3 args"));
|
||||
|
||||
bind "cek-step" (fun args ->
|
||||
match args with
|
||||
| [state] -> Sx_ref.cek_step state
|
||||
| _ -> raise (Eval_error "cek-step: expected 1 arg"));
|
||||
|
||||
bind "cek-phase" (fun args ->
|
||||
match args with
|
||||
| [state] -> Sx_ref.cek_phase state
|
||||
| _ -> raise (Eval_error "cek-phase: expected 1 arg"));
|
||||
|
||||
bind "cek-value" (fun args ->
|
||||
match args with
|
||||
| [state] -> Sx_ref.cek_value state
|
||||
| _ -> raise (Eval_error "cek-value: expected 1 arg"));
|
||||
|
||||
bind "cek-terminal?" (fun args ->
|
||||
match args with
|
||||
| [state] -> Sx_ref.cek_terminal_p state
|
||||
| _ -> raise (Eval_error "cek-terminal?: expected 1 arg"));
|
||||
|
||||
bind "cek-kont" (fun args ->
|
||||
match args with
|
||||
| [state] -> Sx_ref.cek_kont state
|
||||
| _ -> raise (Eval_error "cek-kont: expected 1 arg"));
|
||||
|
||||
bind "frame-type" (fun args ->
|
||||
match args with
|
||||
| [frame] -> Sx_ref.frame_type frame
|
||||
| _ -> raise (Eval_error "frame-type: expected 1 arg"));
|
||||
|
||||
(* --- Strict mode --- *)
|
||||
(* *strict* is a plain value in the env, mutated via env_set by set-strict! *)
|
||||
ignore (Sx_types.env_bind env "*strict*" (Bool false));
|
||||
ignore (Sx_types.env_bind env "*prim-param-types*" Nil);
|
||||
|
||||
bind "set-strict!" (fun args ->
|
||||
match args with
|
||||
| [v] ->
|
||||
Sx_ref._strict_ref := v;
|
||||
ignore (Sx_types.env_set env "*strict*" v); Nil
|
||||
| _ -> raise (Eval_error "set-strict!: expected 1 arg"));
|
||||
|
||||
bind "set-prim-param-types!" (fun args ->
|
||||
match args with
|
||||
| [v] ->
|
||||
Sx_ref._prim_param_types_ref := v;
|
||||
ignore (Sx_types.env_set env "*prim-param-types*" v); Nil
|
||||
| _ -> raise (Eval_error "set-prim-param-types!: expected 1 arg"));
|
||||
|
||||
bind "value-matches-type?" (fun args ->
|
||||
match args with
|
||||
| [v; String expected] -> Sx_ref.value_matches_type_p v (String expected)
|
||||
| _ -> raise (Eval_error "value-matches-type?: expected value and type string"));
|
||||
|
||||
env
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Foundation tests (direct, no evaluator) *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let run_foundation_tests () =
|
||||
Printf.printf "=== SX OCaml Foundation Tests ===\n\n";
|
||||
|
||||
let assert_eq name expected actual =
|
||||
if deep_equal expected actual then begin
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: %s\n" name
|
||||
end else begin
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: %s — expected %s, got %s\n" name
|
||||
(Sx_types.inspect expected) (Sx_types.inspect actual)
|
||||
end
|
||||
in
|
||||
let assert_true name v =
|
||||
if sx_truthy v then begin
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: %s\n" name
|
||||
end else begin
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: %s — expected truthy, got %s\n" name (Sx_types.inspect v)
|
||||
end
|
||||
in
|
||||
let call name args =
|
||||
match Hashtbl.find_opt primitives name with
|
||||
| Some f -> f args
|
||||
| None -> failwith ("Unknown primitive: " ^ name)
|
||||
in
|
||||
|
||||
Printf.printf "Suite: parser\n";
|
||||
assert_eq "number" (Number 42.0) (List.hd (parse_all "42"));
|
||||
assert_eq "string" (String "hello") (List.hd (parse_all "\"hello\""));
|
||||
assert_eq "bool true" (Bool true) (List.hd (parse_all "true"));
|
||||
assert_eq "nil" Nil (List.hd (parse_all "nil"));
|
||||
assert_eq "keyword" (Keyword "class") (List.hd (parse_all ":class"));
|
||||
assert_eq "symbol" (Symbol "foo") (List.hd (parse_all "foo"));
|
||||
assert_eq "list" (List [Symbol "+"; Number 1.0; Number 2.0]) (List.hd (parse_all "(+ 1 2)"));
|
||||
(match List.hd (parse_all "(div :class \"card\" (p \"hi\"))") with
|
||||
| List [Symbol "div"; Keyword "class"; String "card"; List [Symbol "p"; String "hi"]] ->
|
||||
incr pass_count; Printf.printf " PASS: nested list\n"
|
||||
| v -> incr fail_count; Printf.printf " FAIL: nested list — got %s\n" (Sx_types.inspect v));
|
||||
(match List.hd (parse_all "'(1 2 3)") with
|
||||
| List [Symbol "quote"; List [Number 1.0; Number 2.0; Number 3.0]] ->
|
||||
incr pass_count; Printf.printf " PASS: quote sugar\n"
|
||||
| v -> incr fail_count; Printf.printf " FAIL: quote sugar — got %s\n" (Sx_types.inspect v));
|
||||
(match List.hd (parse_all "{:a 1 :b 2}") with
|
||||
| Dict d when dict_has d "a" && dict_has d "b" ->
|
||||
incr pass_count; Printf.printf " PASS: dict literal\n"
|
||||
| v -> incr fail_count; Printf.printf " FAIL: dict literal — got %s\n" (Sx_types.inspect v));
|
||||
assert_eq "comment" (Number 42.0) (List.hd (parse_all ";; comment\n42"));
|
||||
assert_eq "string escape" (String "hello\nworld") (List.hd (parse_all "\"hello\\nworld\""));
|
||||
assert_eq "multiple exprs" (Number 2.0) (Number (float_of_int (List.length (parse_all "(1 2 3) (4 5)"))));
|
||||
|
||||
Printf.printf "\nSuite: primitives\n";
|
||||
assert_eq "+" (Number 6.0) (call "+" [Number 1.0; Number 2.0; Number 3.0]);
|
||||
assert_eq "-" (Number 3.0) (call "-" [Number 5.0; Number 2.0]);
|
||||
assert_eq "*" (Number 12.0) (call "*" [Number 3.0; Number 4.0]);
|
||||
assert_eq "/" (Number 2.5) (call "/" [Number 5.0; Number 2.0]);
|
||||
assert_eq "mod" (Number 1.0) (call "mod" [Number 5.0; Number 2.0]);
|
||||
assert_eq "inc" (Number 6.0) (call "inc" [Number 5.0]);
|
||||
assert_eq "abs" (Number 5.0) (call "abs" [Number (-5.0)]);
|
||||
assert_true "=" (call "=" [Number 1.0; Number 1.0]);
|
||||
assert_true "!=" (call "!=" [Number 1.0; Number 2.0]);
|
||||
assert_true "<" (call "<" [Number 1.0; Number 2.0]);
|
||||
assert_true ">" (call ">" [Number 2.0; Number 1.0]);
|
||||
assert_true "nil?" (call "nil?" [Nil]);
|
||||
assert_true "number?" (call "number?" [Number 1.0]);
|
||||
assert_true "string?" (call "string?" [String "hi"]);
|
||||
assert_true "list?" (call "list?" [List [Number 1.0]]);
|
||||
assert_true "empty? list" (call "empty?" [List []]);
|
||||
assert_true "empty? string" (call "empty?" [String ""]);
|
||||
assert_eq "str" (String "hello42") (call "str" [String "hello"; Number 42.0]);
|
||||
assert_eq "upper" (String "HI") (call "upper" [String "hi"]);
|
||||
assert_eq "trim" (String "hi") (call "trim" [String " hi "]);
|
||||
assert_eq "join" (String "a,b,c") (call "join" [String ","; List [String "a"; String "b"; String "c"]]);
|
||||
assert_true "starts-with?" (call "starts-with?" [String "hello"; String "hel"]);
|
||||
assert_true "contains?" (call "contains?" [List [Number 1.0; Number 2.0; Number 3.0]; Number 2.0]);
|
||||
assert_eq "list" (List [Number 1.0; Number 2.0]) (call "list" [Number 1.0; Number 2.0]);
|
||||
assert_eq "len" (Number 3.0) (call "len" [List [Number 1.0; Number 2.0; Number 3.0]]);
|
||||
assert_eq "first" (Number 1.0) (call "first" [List [Number 1.0; Number 2.0]]);
|
||||
assert_eq "rest" (List [Number 2.0; Number 3.0]) (call "rest" [List [Number 1.0; Number 2.0; Number 3.0]]);
|
||||
assert_eq "nth" (Number 2.0) (call "nth" [List [Number 1.0; Number 2.0]; Number 1.0]);
|
||||
assert_eq "cons" (List [Number 0.0; Number 1.0]) (call "cons" [Number 0.0; List [Number 1.0]]);
|
||||
assert_eq "append" (List [Number 1.0; Number 2.0; Number 3.0])
|
||||
(call "append" [List [Number 1.0]; List [Number 2.0; Number 3.0]]);
|
||||
assert_eq "reverse" (List [Number 3.0; Number 2.0; Number 1.0])
|
||||
(call "reverse" [List [Number 1.0; Number 2.0; Number 3.0]]);
|
||||
assert_eq "range" (List [Number 0.0; Number 1.0; Number 2.0]) (call "range" [Number 3.0]);
|
||||
assert_eq "slice" (List [Number 2.0; Number 3.0])
|
||||
(call "slice" [List [Number 1.0; Number 2.0; Number 3.0]; Number 1.0]);
|
||||
assert_eq "type-of" (String "number") (call "type-of" [Number 1.0]);
|
||||
assert_eq "type-of nil" (String "nil") (call "type-of" [Nil]);
|
||||
|
||||
Printf.printf "\nSuite: env\n";
|
||||
let e = Sx_types.make_env () in
|
||||
ignore (Sx_types.env_bind e "x" (Number 42.0));
|
||||
assert_eq "env-bind + get" (Number 42.0) (Sx_types.env_get e "x");
|
||||
assert_true "env-has" (Bool (Sx_types.env_has e "x"));
|
||||
let child = Sx_types.env_extend e in
|
||||
ignore (Sx_types.env_bind child "y" (Number 10.0));
|
||||
assert_eq "child sees parent" (Number 42.0) (Sx_types.env_get child "x");
|
||||
assert_eq "child own binding" (Number 10.0) (Sx_types.env_get child "y");
|
||||
ignore (Sx_types.env_set child "x" (Number 99.0));
|
||||
assert_eq "set! walks chain" (Number 99.0) (Sx_types.env_get e "x");
|
||||
|
||||
Printf.printf "\nSuite: types\n";
|
||||
assert_true "sx_truthy true" (Bool (sx_truthy (Bool true)));
|
||||
assert_true "sx_truthy 0" (Bool (sx_truthy (Number 0.0)));
|
||||
assert_true "sx_truthy \"\"" (Bool (sx_truthy (String "")));
|
||||
assert_eq "not truthy nil" (Bool false) (Bool (sx_truthy Nil));
|
||||
assert_eq "not truthy false" (Bool false) (Bool (sx_truthy (Bool false)));
|
||||
let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = Sx_types.make_env (); l_name = None } in
|
||||
assert_true "is_lambda" (Bool (Sx_types.is_lambda (Lambda l)));
|
||||
ignore (Sx_types.set_lambda_name (Lambda l) "my-fn");
|
||||
assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l))
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Spec test runner *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let run_spec_tests env test_files =
|
||||
(* Find project root: walk up from cwd until we find spec/tests *)
|
||||
let rec find_root dir =
|
||||
let candidate = Filename.concat dir "spec/tests" in
|
||||
if Sys.file_exists candidate then dir
|
||||
else
|
||||
let parent = Filename.dirname dir in
|
||||
if parent = dir then Sys.getcwd () (* reached filesystem root *)
|
||||
else find_root parent
|
||||
in
|
||||
let project_dir = find_root (Sys.getcwd ()) in
|
||||
let spec_tests_dir = Filename.concat project_dir "spec/tests" in
|
||||
let framework_path = Filename.concat spec_tests_dir "test-framework.sx" in
|
||||
|
||||
if not (Sys.file_exists framework_path) then begin
|
||||
Printf.eprintf "test-framework.sx not found at %s\n" framework_path;
|
||||
Printf.eprintf "Run from the project root directory.\n";
|
||||
exit 1
|
||||
end;
|
||||
|
||||
let load_and_eval path =
|
||||
let ic = open_in path in
|
||||
let n = in_channel_length ic in
|
||||
let s = Bytes.create n in
|
||||
really_input ic s 0 n;
|
||||
close_in ic;
|
||||
let src = Bytes.to_string s in
|
||||
let exprs = parse_all src in
|
||||
List.iter (fun expr ->
|
||||
ignore (eval_expr expr (Env env))
|
||||
) exprs
|
||||
in
|
||||
|
||||
Printf.printf "\nLoading test framework...\n%!";
|
||||
load_and_eval framework_path;
|
||||
|
||||
(* Determine test files *)
|
||||
let files = if test_files = [] then begin
|
||||
let entries = Sys.readdir spec_tests_dir in
|
||||
Array.sort String.compare entries;
|
||||
let requires_full = ["test-continuations.sx"; "test-types.sx"; "test-freeze.sx";
|
||||
"test-continuations-advanced.sx"; "test-signals-advanced.sx"] in
|
||||
Array.to_list entries
|
||||
|> List.filter (fun f ->
|
||||
String.length f > 5 &&
|
||||
String.sub f 0 5 = "test-" &&
|
||||
Filename.check_suffix f ".sx" &&
|
||||
f <> "test-framework.sx" &&
|
||||
not (List.mem f requires_full))
|
||||
end else
|
||||
List.map (fun name ->
|
||||
if Filename.check_suffix name ".sx" then name
|
||||
else name ^ ".sx") test_files
|
||||
in
|
||||
|
||||
List.iter (fun name ->
|
||||
let path = Filename.concat spec_tests_dir name in
|
||||
if Sys.file_exists path then begin
|
||||
Printf.printf "\n%s\n" (String.make 60 '=');
|
||||
Printf.printf "Running %s\n" name;
|
||||
Printf.printf "%s\n%!" (String.make 60 '=');
|
||||
(try
|
||||
load_and_eval path
|
||||
with
|
||||
| Eval_error msg ->
|
||||
incr fail_count;
|
||||
Printf.printf " ERROR in %s: %s\n%!" name msg
|
||||
| exn ->
|
||||
incr fail_count;
|
||||
Printf.printf " ERROR in %s: %s\n%!" name (Printexc.to_string exn))
|
||||
end else
|
||||
Printf.eprintf "Test file not found: %s\n" path
|
||||
) files
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Main *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let () =
|
||||
let args = Array.to_list Sys.argv |> List.tl in
|
||||
let foundation_only = List.mem "--foundation" args in
|
||||
let test_files = List.filter (fun a -> not (String.length a > 0 && a.[0] = '-')) args in
|
||||
|
||||
(* Always run foundation tests *)
|
||||
run_foundation_tests ();
|
||||
|
||||
if not foundation_only then begin
|
||||
Printf.printf "\n=== SX Spec Tests (CEK Evaluator) ===\n%!";
|
||||
let env = make_test_env () in
|
||||
run_spec_tests env test_files
|
||||
end;
|
||||
|
||||
(* Summary *)
|
||||
Printf.printf "\n%s\n" (String.make 60 '=');
|
||||
Printf.printf "Results: %d passed, %d failed\n" !pass_count !fail_count;
|
||||
Printf.printf "%s\n" (String.make 60 '=');
|
||||
if !fail_count > 0 then exit 1
|
||||
427
hosts/ocaml/bin/sx_server.ml
Normal file
427
hosts/ocaml/bin/sx_server.ml
Normal file
@@ -0,0 +1,427 @@
|
||||
(** SX coroutine subprocess server.
|
||||
|
||||
Persistent process that accepts commands on stdin and writes
|
||||
responses on stdout. All messages are single-line SX expressions,
|
||||
newline-delimited.
|
||||
|
||||
Protocol:
|
||||
Python → OCaml: (ping), (load path), (load-source src),
|
||||
(eval src), (render src), (reset),
|
||||
(io-response value)
|
||||
OCaml → Python: (ready), (ok), (ok value), (error msg),
|
||||
(io-request name args...)
|
||||
|
||||
IO primitives (query, action, request-arg, request-method, ctx)
|
||||
yield (io-request ...) and block on stdin for (io-response ...). *)
|
||||
|
||||
module Sx_types = Sx.Sx_types
|
||||
module Sx_parser = Sx.Sx_parser
|
||||
module Sx_primitives = Sx.Sx_primitives
|
||||
module Sx_runtime = Sx.Sx_runtime
|
||||
module Sx_ref = Sx.Sx_ref
|
||||
module Sx_render = Sx.Sx_render
|
||||
|
||||
open Sx_types
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Output helpers *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
(** Escape a string for embedding in an SX string literal. *)
|
||||
let escape_sx_string s =
|
||||
let buf = Buffer.create (String.length s + 16) in
|
||||
String.iter (function
|
||||
| '"' -> Buffer.add_string buf "\\\""
|
||||
| '\\' -> Buffer.add_string buf "\\\\"
|
||||
| '\n' -> Buffer.add_string buf "\\n"
|
||||
| '\r' -> Buffer.add_string buf "\\r"
|
||||
| '\t' -> Buffer.add_string buf "\\t"
|
||||
| c -> Buffer.add_char buf c) s;
|
||||
Buffer.contents buf
|
||||
|
||||
(** Serialize a value to SX text (for io-request args). *)
|
||||
let rec serialize_value = function
|
||||
| Nil -> "nil"
|
||||
| Bool true -> "true"
|
||||
| Bool false -> "false"
|
||||
| Number n ->
|
||||
if Float.is_integer n then string_of_int (int_of_float n)
|
||||
else Printf.sprintf "%g" n
|
||||
| String s -> "\"" ^ escape_sx_string s ^ "\""
|
||||
| Symbol s -> s
|
||||
| Keyword k -> ":" ^ k
|
||||
| List items | ListRef { contents = items } ->
|
||||
"(list " ^ String.concat " " (List.map serialize_value items) ^ ")"
|
||||
| Dict d ->
|
||||
let pairs = Hashtbl.fold (fun k v acc ->
|
||||
(Printf.sprintf ":%s %s" k (serialize_value v)) :: acc) d [] in
|
||||
"{" ^ String.concat " " pairs ^ "}"
|
||||
| RawHTML s -> "\"" ^ escape_sx_string s ^ "\""
|
||||
| _ -> "nil"
|
||||
|
||||
let send line =
|
||||
print_string line;
|
||||
print_char '\n';
|
||||
flush stdout
|
||||
|
||||
let send_ok () = send "(ok)"
|
||||
let send_ok_value v = send (Printf.sprintf "(ok %s)" (serialize_value v))
|
||||
let send_ok_string s = send (Printf.sprintf "(ok \"%s\")" (escape_sx_string s))
|
||||
let send_error msg = send (Printf.sprintf "(error \"%s\")" (escape_sx_string msg))
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* IO bridge — primitives that yield to Python *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
(** Read a line from stdin (blocking). *)
|
||||
let read_line_blocking () =
|
||||
try Some (input_line stdin)
|
||||
with End_of_file -> None
|
||||
|
||||
(** Send an io-request and block until io-response arrives. *)
|
||||
let io_request name args =
|
||||
let args_str = String.concat " " (List.map serialize_value args) in
|
||||
send (Printf.sprintf "(io-request \"%s\" %s)" name args_str);
|
||||
(* Block on stdin for io-response *)
|
||||
match read_line_blocking () with
|
||||
| None -> raise (Eval_error "IO bridge: stdin closed while waiting for io-response")
|
||||
| Some line ->
|
||||
let exprs = Sx_parser.parse_all line in
|
||||
match exprs with
|
||||
| [List [Symbol "io-response"; value]] -> value
|
||||
| [List (Symbol "io-response" :: values)] ->
|
||||
(match values with
|
||||
| [v] -> v
|
||||
| _ -> List values)
|
||||
| _ -> raise (Eval_error ("IO bridge: unexpected response: " ^ line))
|
||||
|
||||
(** Bind IO primitives into the environment. *)
|
||||
let setup_io_env env =
|
||||
let bind name fn =
|
||||
ignore (env_bind env name (NativeFn (name, fn)))
|
||||
in
|
||||
|
||||
bind "query" (fun args ->
|
||||
match args with
|
||||
| service :: query_name :: rest ->
|
||||
io_request "query" (service :: query_name :: rest)
|
||||
| _ -> raise (Eval_error "query: expected (query service name ...)"));
|
||||
|
||||
bind "action" (fun args ->
|
||||
match args with
|
||||
| service :: action_name :: rest ->
|
||||
io_request "action" (service :: action_name :: rest)
|
||||
| _ -> raise (Eval_error "action: expected (action service name ...)"));
|
||||
|
||||
bind "request-arg" (fun args ->
|
||||
match args with
|
||||
| [name] -> io_request "request-arg" [name]
|
||||
| _ -> raise (Eval_error "request-arg: expected 1 arg"));
|
||||
|
||||
bind "request-method" (fun _args ->
|
||||
io_request "request-method" []);
|
||||
|
||||
bind "ctx" (fun args ->
|
||||
match args with
|
||||
| [key] -> io_request "ctx" [key]
|
||||
| _ -> raise (Eval_error "ctx: expected 1 arg"))
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Environment setup *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let make_server_env () =
|
||||
let env = make_env () in
|
||||
|
||||
(* Evaluator bindings — same as run_tests.ml's make_test_env,
|
||||
but only the ones needed for rendering (not test helpers). *)
|
||||
let bind name fn =
|
||||
ignore (env_bind env name (NativeFn (name, fn)))
|
||||
in
|
||||
|
||||
bind "assert" (fun args ->
|
||||
match args with
|
||||
| [cond] ->
|
||||
if not (sx_truthy cond) then raise (Eval_error "Assertion failed");
|
||||
Bool true
|
||||
| [cond; String msg] ->
|
||||
if not (sx_truthy cond) then raise (Eval_error ("Assertion error: " ^ msg));
|
||||
Bool true
|
||||
| [cond; msg] ->
|
||||
if not (sx_truthy cond) then
|
||||
raise (Eval_error ("Assertion error: " ^ value_to_string msg));
|
||||
Bool true
|
||||
| _ -> raise (Eval_error "assert: expected 1-2 args"));
|
||||
|
||||
bind "append!" (fun args ->
|
||||
match args with
|
||||
| [ListRef r; v] -> r := !r @ [v]; ListRef r
|
||||
| [List items; v] -> List (items @ [v])
|
||||
| _ -> raise (Eval_error "append!: expected list and value"));
|
||||
|
||||
(* HTML renderer *)
|
||||
Sx_render.setup_render_env env;
|
||||
|
||||
(* Missing primitives that may be referenced *)
|
||||
bind "upcase" (fun args ->
|
||||
match args with
|
||||
| [String s] -> String (String.uppercase_ascii s)
|
||||
| _ -> raise (Eval_error "upcase: expected string"));
|
||||
|
||||
bind "downcase" (fun args ->
|
||||
match args with
|
||||
| [String s] -> String (String.lowercase_ascii s)
|
||||
| _ -> raise (Eval_error "downcase: expected string"));
|
||||
|
||||
bind "make-keyword" (fun args ->
|
||||
match args with
|
||||
| [String s] -> Keyword s
|
||||
| _ -> raise (Eval_error "make-keyword: expected string"));
|
||||
|
||||
bind "string-length" (fun args ->
|
||||
match args with
|
||||
| [String s] -> Number (float_of_int (String.length s))
|
||||
| _ -> raise (Eval_error "string-length: expected string"));
|
||||
|
||||
bind "dict-get" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k] -> dict_get d k
|
||||
| [Dict d; Keyword k] -> dict_get d k
|
||||
| _ -> raise (Eval_error "dict-get: expected dict and key"));
|
||||
|
||||
bind "apply" (fun args ->
|
||||
match args with
|
||||
| f :: rest ->
|
||||
let all_args = match List.rev rest with
|
||||
| List last :: prefix -> List.rev prefix @ last
|
||||
| _ -> rest
|
||||
in
|
||||
Sx_runtime.sx_call f all_args
|
||||
| _ -> raise (Eval_error "apply: expected function and args"));
|
||||
|
||||
bind "equal?" (fun args ->
|
||||
match args with
|
||||
| [a; b] -> Bool (a = b)
|
||||
| _ -> raise (Eval_error "equal?: expected 2 args"));
|
||||
|
||||
bind "identical?" (fun args ->
|
||||
match args with
|
||||
| [a; b] -> Bool (a == b)
|
||||
| _ -> raise (Eval_error "identical?: expected 2 args"));
|
||||
|
||||
bind "make-continuation" (fun args ->
|
||||
match args with
|
||||
| [f] ->
|
||||
let k v = Sx_runtime.sx_call f [v] in
|
||||
Continuation (k, None)
|
||||
| _ -> raise (Eval_error "make-continuation: expected 1 arg"));
|
||||
|
||||
bind "continuation?" (fun args ->
|
||||
match args with
|
||||
| [Continuation _] -> Bool true
|
||||
| [_] -> Bool false
|
||||
| _ -> raise (Eval_error "continuation?: expected 1 arg"));
|
||||
|
||||
bind "make-symbol" (fun args ->
|
||||
match args with
|
||||
| [String s] -> Symbol s
|
||||
| [v] -> Symbol (value_to_string v)
|
||||
| _ -> raise (Eval_error "make-symbol: expected 1 arg"));
|
||||
|
||||
bind "sx-serialize" (fun args ->
|
||||
match args with
|
||||
| [v] -> String (inspect v)
|
||||
| _ -> raise (Eval_error "sx-serialize: expected 1 arg"));
|
||||
|
||||
(* Env operations *)
|
||||
bind "env-get" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k] -> env_get e k
|
||||
| [Env e; Keyword k] -> env_get e k
|
||||
| _ -> raise (Eval_error "env-get: expected env and string"));
|
||||
|
||||
bind "env-has?" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k] -> Bool (env_has e k)
|
||||
| [Env e; Keyword k] -> Bool (env_has e k)
|
||||
| _ -> raise (Eval_error "env-has?: expected env and string"));
|
||||
|
||||
bind "env-bind!" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k; v] -> env_bind e k v
|
||||
| [Env e; Keyword k; v] -> env_bind e k v
|
||||
| _ -> raise (Eval_error "env-bind!: expected env, key, value"));
|
||||
|
||||
bind "env-set!" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k; v] -> env_set e k v
|
||||
| [Env e; Keyword k; v] -> env_set e k v
|
||||
| _ -> raise (Eval_error "env-set!: expected env, key, value"));
|
||||
|
||||
bind "env-extend" (fun args ->
|
||||
match args with
|
||||
| [Env e] -> Env (env_extend e)
|
||||
| _ -> raise (Eval_error "env-extend: expected env"));
|
||||
|
||||
bind "env-merge" (fun args ->
|
||||
match args with
|
||||
| [Env a; Env b] -> Env (env_merge a b)
|
||||
| _ -> raise (Eval_error "env-merge: expected 2 envs"));
|
||||
|
||||
(* Strict mode state *)
|
||||
ignore (env_bind env "*strict*" (Bool false));
|
||||
ignore (env_bind env "*prim-param-types*" Nil);
|
||||
|
||||
bind "set-strict!" (fun args ->
|
||||
match args with
|
||||
| [v] ->
|
||||
Sx_ref._strict_ref := v;
|
||||
ignore (env_set env "*strict*" v); Nil
|
||||
| _ -> raise (Eval_error "set-strict!: expected 1 arg"));
|
||||
|
||||
bind "set-prim-param-types!" (fun args ->
|
||||
match args with
|
||||
| [v] ->
|
||||
Sx_ref._prim_param_types_ref := v;
|
||||
ignore (env_set env "*prim-param-types*" v); Nil
|
||||
| _ -> raise (Eval_error "set-prim-param-types!: expected 1 arg"));
|
||||
|
||||
bind "component-param-types" (fun _args -> Nil);
|
||||
bind "component-set-param-types!" (fun _args -> Nil);
|
||||
|
||||
bind "component-params" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> List (List.map (fun s -> String s) c.c_params)
|
||||
| _ -> Nil);
|
||||
|
||||
bind "component-body" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> c.c_body
|
||||
| _ -> Nil);
|
||||
|
||||
bind "component-has-children" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> Bool c.c_has_children
|
||||
| _ -> Bool false);
|
||||
|
||||
bind "component-affinity" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> String c.c_affinity
|
||||
| _ -> String "auto");
|
||||
|
||||
bind "keyword-name" (fun args ->
|
||||
match args with
|
||||
| [Keyword k] -> String k
|
||||
| _ -> raise (Eval_error "keyword-name: expected keyword"));
|
||||
|
||||
bind "symbol-name" (fun args ->
|
||||
match args with
|
||||
| [Symbol s] -> String s
|
||||
| _ -> raise (Eval_error "symbol-name: expected symbol"));
|
||||
|
||||
(* IO primitives *)
|
||||
setup_io_env env;
|
||||
|
||||
env
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Command dispatch *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let dispatch env cmd =
|
||||
match cmd with
|
||||
| List [Symbol "ping"] ->
|
||||
send_ok_string "ocaml-cek"
|
||||
|
||||
| List [Symbol "load"; String path] ->
|
||||
(try
|
||||
let exprs = Sx_parser.parse_file path in
|
||||
let count = ref 0 in
|
||||
List.iter (fun expr ->
|
||||
ignore (Sx_ref.eval_expr expr (Env env));
|
||||
incr count
|
||||
) exprs;
|
||||
send_ok_value (Number (float_of_int !count))
|
||||
with
|
||||
| Eval_error msg -> send_error msg
|
||||
| Sys_error msg -> send_error ("File error: " ^ msg)
|
||||
| exn -> send_error (Printexc.to_string exn))
|
||||
|
||||
| List [Symbol "load-source"; String src] ->
|
||||
(try
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let count = ref 0 in
|
||||
List.iter (fun expr ->
|
||||
ignore (Sx_ref.eval_expr expr (Env env));
|
||||
incr count
|
||||
) exprs;
|
||||
send_ok_value (Number (float_of_int !count))
|
||||
with
|
||||
| Eval_error msg -> send_error msg
|
||||
| exn -> send_error (Printexc.to_string exn))
|
||||
|
||||
| List [Symbol "eval"; String src] ->
|
||||
(try
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let result = List.fold_left (fun _acc expr ->
|
||||
Sx_ref.eval_expr expr (Env env)
|
||||
) Nil exprs in
|
||||
send_ok_value result
|
||||
with
|
||||
| Eval_error msg -> send_error msg
|
||||
| exn -> send_error (Printexc.to_string exn))
|
||||
|
||||
| List [Symbol "render"; String src] ->
|
||||
(try
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let expr = match exprs with
|
||||
| [e] -> e
|
||||
| [] -> Nil
|
||||
| _ -> List (Symbol "do" :: exprs)
|
||||
in
|
||||
let html = Sx_render.render_to_html expr env in
|
||||
send_ok_string html
|
||||
with
|
||||
| Eval_error msg -> send_error msg
|
||||
| exn -> send_error (Printexc.to_string exn))
|
||||
|
||||
| List [Symbol "reset"] ->
|
||||
(* Clear all bindings and rebuild env.
|
||||
We can't reassign env, so clear and re-populate. *)
|
||||
Hashtbl.clear env.bindings;
|
||||
let fresh = make_server_env () in
|
||||
Hashtbl.iter (fun k v -> Hashtbl.replace env.bindings k v) fresh.bindings;
|
||||
send_ok ()
|
||||
|
||||
| _ ->
|
||||
send_error ("Unknown command: " ^ inspect cmd)
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Main loop *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let () =
|
||||
let env = make_server_env () in
|
||||
send "(ready)";
|
||||
(* Main command loop *)
|
||||
try
|
||||
while true do
|
||||
match read_line_blocking () with
|
||||
| None -> exit 0 (* stdin closed *)
|
||||
| Some line ->
|
||||
let line = String.trim line in
|
||||
if line = "" then () (* skip blank lines *)
|
||||
else begin
|
||||
let exprs = Sx_parser.parse_all line in
|
||||
match exprs with
|
||||
| [cmd] -> dispatch env cmd
|
||||
| _ -> send_error ("Expected single command, got " ^ string_of_int (List.length exprs))
|
||||
end
|
||||
done
|
||||
with
|
||||
| End_of_file -> ()
|
||||
150
hosts/ocaml/bootstrap.py
Normal file
150
hosts/ocaml/bootstrap.py
Normal file
@@ -0,0 +1,150 @@
|
||||
#!/usr/bin/env python3
|
||||
"""
|
||||
Bootstrap compiler: SX spec -> OCaml.
|
||||
|
||||
Loads the SX-to-OCaml transpiler (transpiler.sx), feeds it the spec files,
|
||||
and produces sx_ref.ml — the transpiled evaluator as native OCaml.
|
||||
|
||||
Usage:
|
||||
python3 hosts/ocaml/bootstrap.py --output hosts/ocaml/lib/sx_ref.ml
|
||||
"""
|
||||
from __future__ import annotations
|
||||
|
||||
import os
|
||||
import sys
|
||||
|
||||
_HERE = os.path.dirname(os.path.abspath(__file__))
|
||||
_PROJECT = os.path.abspath(os.path.join(_HERE, "..", ".."))
|
||||
sys.path.insert(0, _PROJECT)
|
||||
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.types import Symbol
|
||||
|
||||
|
||||
def extract_defines(source: str) -> list[tuple[str, list]]:
|
||||
"""Parse .sx source, return list of (name, define-expr) for top-level defines."""
|
||||
exprs = parse_all(source)
|
||||
defines = []
|
||||
for expr in exprs:
|
||||
if isinstance(expr, list) and expr and isinstance(expr[0], Symbol):
|
||||
if expr[0].name == "define":
|
||||
name = expr[1].name if isinstance(expr[1], Symbol) else str(expr[1])
|
||||
defines.append((name, expr))
|
||||
return defines
|
||||
|
||||
|
||||
# OCaml preamble — opens and runtime helpers
|
||||
PREAMBLE = """\
|
||||
(* sx_ref.ml — Auto-generated from SX spec by hosts/ocaml/bootstrap.py *)
|
||||
(* Do not edit — regenerate with: python3 hosts/ocaml/bootstrap.py *)
|
||||
|
||||
[@@@warning "-26-27"]
|
||||
|
||||
open Sx_types
|
||||
open Sx_runtime
|
||||
|
||||
(* Trampoline — evaluates thunks via the CEK machine.
|
||||
eval_expr is defined in the transpiled block below. *)
|
||||
let trampoline v = v (* CEK machine doesn't produce thunks *)
|
||||
|
||||
"""
|
||||
|
||||
|
||||
# OCaml fixups — override iterative CEK run
|
||||
FIXUPS = """\
|
||||
|
||||
(* Override recursive cek_run with iterative loop *)
|
||||
let cek_run_iterative state =
|
||||
let s = ref state in
|
||||
while not (match cek_terminal_p !s with Bool true -> true | _ -> false) do
|
||||
s := cek_step !s
|
||||
done;
|
||||
cek_value !s
|
||||
|
||||
"""
|
||||
|
||||
|
||||
def compile_spec_to_ml(spec_dir: str | None = None) -> str:
|
||||
"""Compile the SX spec to OCaml source."""
|
||||
from shared.sx.ref.sx_ref import eval_expr, trampoline, make_env, sx_parse
|
||||
|
||||
if spec_dir is None:
|
||||
spec_dir = os.path.join(_PROJECT, "spec")
|
||||
|
||||
# Load the transpiler
|
||||
env = make_env()
|
||||
transpiler_path = os.path.join(_HERE, "transpiler.sx")
|
||||
with open(transpiler_path) as f:
|
||||
transpiler_src = f.read()
|
||||
for expr in sx_parse(transpiler_src):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Spec files to transpile (in dependency order)
|
||||
sx_files = [
|
||||
("evaluator.sx", "evaluator (frames + eval + CEK)"),
|
||||
]
|
||||
|
||||
parts = [PREAMBLE]
|
||||
|
||||
for filename, label in sx_files:
|
||||
filepath = os.path.join(spec_dir, filename)
|
||||
if not os.path.exists(filepath):
|
||||
print(f"Warning: {filepath} not found, skipping", file=sys.stderr)
|
||||
continue
|
||||
|
||||
with open(filepath) as f:
|
||||
src = f.read()
|
||||
defines = extract_defines(src)
|
||||
|
||||
# Skip defines provided by preamble or fixups
|
||||
skip = {"trampoline"}
|
||||
defines = [(n, e) for n, e in defines if n not in skip]
|
||||
|
||||
# Deduplicate — keep last definition for each name (CEK overrides tree-walk)
|
||||
seen = {}
|
||||
for i, (n, e) in enumerate(defines):
|
||||
seen[n] = i
|
||||
defines = [(n, e) for i, (n, e) in enumerate(defines) if seen[n] == i]
|
||||
|
||||
# Build the defines list for the transpiler
|
||||
defines_list = [[name, expr] for name, expr in defines]
|
||||
env["_defines"] = defines_list
|
||||
|
||||
# Pass known define names so the transpiler can distinguish
|
||||
# static (OCaml fn) calls from dynamic (SX value) calls
|
||||
env["_known_defines"] = [name for name, _ in defines]
|
||||
|
||||
# Call ml-translate-file — emits as single let rec block
|
||||
translate_expr = sx_parse("(ml-translate-file _defines)")[0]
|
||||
result = trampoline(eval_expr(translate_expr, env))
|
||||
|
||||
parts.append(f"\n(* === Transpiled from {label} === *)\n")
|
||||
parts.append(result)
|
||||
|
||||
parts.append(FIXUPS)
|
||||
return "\n".join(parts)
|
||||
|
||||
|
||||
def main():
|
||||
import argparse
|
||||
parser = argparse.ArgumentParser(description="Bootstrap SX spec -> OCaml")
|
||||
parser.add_argument(
|
||||
"--output", "-o",
|
||||
default=None,
|
||||
help="Output file (default: stdout)",
|
||||
)
|
||||
args = parser.parse_args()
|
||||
|
||||
result = compile_spec_to_ml()
|
||||
|
||||
if args.output:
|
||||
with open(args.output, "w") as f:
|
||||
f.write(result)
|
||||
size = os.path.getsize(args.output)
|
||||
print(f"Wrote {args.output} ({size} bytes)", file=sys.stderr)
|
||||
else:
|
||||
print(result)
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
main()
|
||||
2
hosts/ocaml/dune-project
Normal file
2
hosts/ocaml/dune-project
Normal file
@@ -0,0 +1,2 @@
|
||||
(lang dune 3.0)
|
||||
(name sx)
|
||||
2
hosts/ocaml/lib/dune
Normal file
2
hosts/ocaml/lib/dune
Normal file
@@ -0,0 +1,2 @@
|
||||
(library
|
||||
(name sx))
|
||||
206
hosts/ocaml/lib/sx_parser.ml
Normal file
206
hosts/ocaml/lib/sx_parser.ml
Normal file
@@ -0,0 +1,206 @@
|
||||
(** S-expression parser.
|
||||
|
||||
Recursive descent over a string, producing [Sx_types.value list].
|
||||
Supports: lists, dicts, symbols, keywords, strings (with escapes),
|
||||
numbers, booleans, nil, comments, quote/quasiquote/unquote sugar. *)
|
||||
|
||||
open Sx_types
|
||||
|
||||
type state = {
|
||||
src : string;
|
||||
len : int;
|
||||
mutable pos : int;
|
||||
}
|
||||
|
||||
let make_state src = { src; len = String.length src; pos = 0 }
|
||||
|
||||
let peek s = if s.pos < s.len then Some s.src.[s.pos] else None
|
||||
let advance s = s.pos <- s.pos + 1
|
||||
let at_end s = s.pos >= s.len
|
||||
|
||||
let skip_whitespace_and_comments s =
|
||||
let rec go () =
|
||||
if at_end s then ()
|
||||
else match s.src.[s.pos] with
|
||||
| ' ' | '\t' | '\n' | '\r' -> advance s; go ()
|
||||
| ';' ->
|
||||
while s.pos < s.len && s.src.[s.pos] <> '\n' do advance s done;
|
||||
if s.pos < s.len then advance s;
|
||||
go ()
|
||||
| _ -> ()
|
||||
in go ()
|
||||
|
||||
let is_symbol_char = function
|
||||
| '(' | ')' | '[' | ']' | '{' | '}' | '"' | '\'' | '`'
|
||||
| ' ' | '\t' | '\n' | '\r' | ',' | ';' -> false
|
||||
| _ -> true
|
||||
|
||||
let read_string s =
|
||||
(* s.pos is on the opening quote *)
|
||||
advance s;
|
||||
let buf = Buffer.create 64 in
|
||||
let rec go () =
|
||||
if at_end s then raise (Parse_error "Unterminated string");
|
||||
let c = s.src.[s.pos] in
|
||||
advance s;
|
||||
if c = '"' then Buffer.contents buf
|
||||
else if c = '\\' then begin
|
||||
if at_end s then raise (Parse_error "Unterminated string escape");
|
||||
let esc = s.src.[s.pos] in
|
||||
advance s;
|
||||
(match esc with
|
||||
| 'n' -> Buffer.add_char buf '\n'
|
||||
| 't' -> Buffer.add_char buf '\t'
|
||||
| 'r' -> Buffer.add_char buf '\r'
|
||||
| '"' -> Buffer.add_char buf '"'
|
||||
| '\\' -> Buffer.add_char buf '\\'
|
||||
| 'u' ->
|
||||
(* \uXXXX — read 4 hex digits, encode as UTF-8 *)
|
||||
if s.pos + 4 > s.len then raise (Parse_error "Incomplete \\u escape");
|
||||
let hex = String.sub s.src s.pos 4 in
|
||||
s.pos <- s.pos + 4;
|
||||
let code = int_of_string ("0x" ^ hex) in
|
||||
let ubuf = Buffer.create 4 in
|
||||
Buffer.add_utf_8_uchar ubuf (Uchar.of_int code);
|
||||
Buffer.add_string buf (Buffer.contents ubuf)
|
||||
| '`' -> Buffer.add_char buf '`'
|
||||
| _ -> Buffer.add_char buf '\\'; Buffer.add_char buf esc);
|
||||
go ()
|
||||
end else begin
|
||||
Buffer.add_char buf c;
|
||||
go ()
|
||||
end
|
||||
in go ()
|
||||
|
||||
let read_symbol s =
|
||||
let start = s.pos in
|
||||
while s.pos < s.len && is_symbol_char s.src.[s.pos] do advance s done;
|
||||
String.sub s.src start (s.pos - start)
|
||||
|
||||
let try_number str =
|
||||
match float_of_string_opt str with
|
||||
| Some n -> Some (Number n)
|
||||
| None -> None
|
||||
|
||||
let rec read_value s : value =
|
||||
skip_whitespace_and_comments s;
|
||||
if at_end s then raise (Parse_error "Unexpected end of input");
|
||||
match s.src.[s.pos] with
|
||||
| '(' -> read_list s ')'
|
||||
| '[' -> read_list s ']'
|
||||
| '{' -> read_dict s
|
||||
| '"' -> String (read_string s)
|
||||
| '\'' -> advance s; List [Symbol "quote"; read_value s]
|
||||
| '`' -> advance s; List [Symbol "quasiquote"; read_value s]
|
||||
| '#' when s.pos + 1 < s.len && s.src.[s.pos + 1] = ';' ->
|
||||
(* Datum comment: #; discards next expression *)
|
||||
advance s; advance s;
|
||||
ignore (read_value s);
|
||||
read_value s
|
||||
| '#' when s.pos + 1 < s.len && s.src.[s.pos + 1] = '\'' ->
|
||||
(* Quote shorthand: #'expr -> (quote expr) *)
|
||||
advance s; advance s;
|
||||
List [Symbol "quote"; read_value s]
|
||||
| '#' when s.pos + 1 < s.len && s.src.[s.pos + 1] = '|' ->
|
||||
(* Raw string: #|...| — ends at next | *)
|
||||
advance s; advance s;
|
||||
let buf = Buffer.create 64 in
|
||||
let rec go () =
|
||||
if at_end s then raise (Parse_error "Unterminated raw string");
|
||||
let c = s.src.[s.pos] in
|
||||
advance s;
|
||||
if c = '|' then
|
||||
String (Buffer.contents buf)
|
||||
else begin
|
||||
Buffer.add_char buf c;
|
||||
go ()
|
||||
end
|
||||
in go ()
|
||||
| '~' when s.pos + 1 < s.len && s.src.[s.pos + 1] = '@' ->
|
||||
advance s; advance s; (* skip ~@ *)
|
||||
List [Symbol "splice-unquote"; read_value s]
|
||||
| _ ->
|
||||
(* Check for unquote: , followed by non-whitespace *)
|
||||
if s.src.[s.pos] = ',' && s.pos + 1 < s.len &&
|
||||
s.src.[s.pos + 1] <> ' ' && s.src.[s.pos + 1] <> '\n' then begin
|
||||
advance s;
|
||||
if s.pos < s.len && s.src.[s.pos] = '@' then begin
|
||||
advance s;
|
||||
List [Symbol "splice-unquote"; read_value s]
|
||||
end else
|
||||
List [Symbol "unquote"; read_value s]
|
||||
end else begin
|
||||
(* Symbol, keyword, number, or boolean *)
|
||||
let token = read_symbol s in
|
||||
if token = "" then raise (Parse_error ("Unexpected char: " ^ String.make 1 s.src.[s.pos]));
|
||||
match token with
|
||||
| "true" -> Bool true
|
||||
| "false" -> Bool false
|
||||
| "nil" -> Nil
|
||||
| _ when token.[0] = ':' ->
|
||||
Keyword (String.sub token 1 (String.length token - 1))
|
||||
| _ ->
|
||||
match try_number token with
|
||||
| Some n -> n
|
||||
| None -> Symbol token
|
||||
end
|
||||
|
||||
and read_list s close_char =
|
||||
advance s; (* skip opening paren/bracket *)
|
||||
let items = ref [] in
|
||||
let rec go () =
|
||||
skip_whitespace_and_comments s;
|
||||
if at_end s then raise (Parse_error "Unterminated list");
|
||||
if s.src.[s.pos] = close_char then begin
|
||||
advance s;
|
||||
List (List.rev !items)
|
||||
end else begin
|
||||
items := read_value s :: !items;
|
||||
go ()
|
||||
end
|
||||
in go ()
|
||||
|
||||
and read_dict s =
|
||||
advance s; (* skip { *)
|
||||
let d = make_dict () in
|
||||
let rec go () =
|
||||
skip_whitespace_and_comments s;
|
||||
if at_end s then raise (Parse_error "Unterminated dict");
|
||||
if s.src.[s.pos] = '}' then begin
|
||||
advance s;
|
||||
Dict d
|
||||
end else begin
|
||||
let key = read_value s in
|
||||
let key_str = match key with
|
||||
| Keyword k -> k
|
||||
| String k -> k
|
||||
| Symbol k -> k
|
||||
| _ -> raise (Parse_error "Dict key must be keyword, string, or symbol")
|
||||
in
|
||||
let v = read_value s in
|
||||
dict_set d key_str v;
|
||||
go ()
|
||||
end
|
||||
in go ()
|
||||
|
||||
|
||||
(** Parse a string into a list of SX values. *)
|
||||
let parse_all src =
|
||||
let s = make_state src in
|
||||
let results = ref [] in
|
||||
let rec go () =
|
||||
skip_whitespace_and_comments s;
|
||||
if at_end s then List.rev !results
|
||||
else begin
|
||||
results := read_value s :: !results;
|
||||
go ()
|
||||
end
|
||||
in go ()
|
||||
|
||||
(** Parse a file into a list of SX values. *)
|
||||
let parse_file path =
|
||||
let ic = open_in path in
|
||||
let n = in_channel_length ic in
|
||||
let src = really_input_string ic n in
|
||||
close_in ic;
|
||||
parse_all src
|
||||
578
hosts/ocaml/lib/sx_primitives.ml
Normal file
578
hosts/ocaml/lib/sx_primitives.ml
Normal file
@@ -0,0 +1,578 @@
|
||||
(** Built-in primitive functions (~80 pure functions).
|
||||
|
||||
Registered in a global table; the evaluator checks this table
|
||||
when a symbol isn't found in the lexical environment. *)
|
||||
|
||||
open Sx_types
|
||||
|
||||
let primitives : (string, value list -> value) Hashtbl.t = Hashtbl.create 128
|
||||
|
||||
let register name fn = Hashtbl.replace primitives name fn
|
||||
|
||||
let is_primitive name = Hashtbl.mem primitives name
|
||||
|
||||
let get_primitive name =
|
||||
match Hashtbl.find_opt primitives name with
|
||||
| Some fn -> NativeFn (name, fn)
|
||||
| None -> raise (Eval_error ("Unknown primitive: " ^ name))
|
||||
|
||||
(* --- Helpers --- *)
|
||||
|
||||
let as_number = function
|
||||
| Number n -> n
|
||||
| Bool true -> 1.0
|
||||
| Bool false -> 0.0
|
||||
| Nil -> 0.0
|
||||
| String s -> (match float_of_string_opt s with Some n -> n | None -> Float.nan)
|
||||
| v -> raise (Eval_error ("Expected number, got " ^ type_of v))
|
||||
|
||||
let as_string = function
|
||||
| String s -> s
|
||||
| v -> raise (Eval_error ("Expected string, got " ^ type_of v))
|
||||
|
||||
let as_list = function
|
||||
| List l -> l
|
||||
| ListRef r -> !r
|
||||
| Nil -> []
|
||||
| v -> raise (Eval_error ("Expected list, got " ^ type_of v))
|
||||
|
||||
let as_bool = function
|
||||
| Bool b -> b
|
||||
| v -> sx_truthy v
|
||||
|
||||
let to_string = function
|
||||
| String s -> s
|
||||
| Number n ->
|
||||
if Float.is_integer n then string_of_int (int_of_float n)
|
||||
else Printf.sprintf "%g" n
|
||||
| Bool true -> "true"
|
||||
| Bool false -> "false"
|
||||
| Nil -> ""
|
||||
| Symbol s -> s
|
||||
| Keyword k -> k
|
||||
| v -> inspect v
|
||||
|
||||
let () =
|
||||
(* === Arithmetic === *)
|
||||
register "+" (fun args ->
|
||||
Number (List.fold_left (fun acc a -> acc +. as_number a) 0.0 args));
|
||||
register "-" (fun args ->
|
||||
match args with
|
||||
| [] -> Number 0.0
|
||||
| [a] -> Number (-. (as_number a))
|
||||
| a :: rest -> Number (List.fold_left (fun acc x -> acc -. as_number x) (as_number a) rest));
|
||||
register "*" (fun args ->
|
||||
Number (List.fold_left (fun acc a -> acc *. as_number a) 1.0 args));
|
||||
register "/" (fun args ->
|
||||
match args with
|
||||
| [a; b] -> Number (as_number a /. as_number b)
|
||||
| _ -> raise (Eval_error "/: expected 2 args"));
|
||||
register "mod" (fun args ->
|
||||
match args with
|
||||
| [a; b] -> Number (Float.rem (as_number a) (as_number b))
|
||||
| _ -> raise (Eval_error "mod: expected 2 args"));
|
||||
register "inc" (fun args ->
|
||||
match args with [a] -> Number (as_number a +. 1.0) | _ -> raise (Eval_error "inc: 1 arg"));
|
||||
register "dec" (fun args ->
|
||||
match args with [a] -> Number (as_number a -. 1.0) | _ -> raise (Eval_error "dec: 1 arg"));
|
||||
register "abs" (fun args ->
|
||||
match args with [a] -> Number (Float.abs (as_number a)) | _ -> raise (Eval_error "abs: 1 arg"));
|
||||
register "floor" (fun args ->
|
||||
match args with [a] -> Number (Float.of_int (int_of_float (Float.round (as_number a -. 0.5))))
|
||||
| _ -> raise (Eval_error "floor: 1 arg"));
|
||||
register "ceil" (fun args ->
|
||||
match args with [a] -> Number (Float.of_int (int_of_float (Float.round (as_number a +. 0.5))))
|
||||
| _ -> raise (Eval_error "ceil: 1 arg"));
|
||||
register "round" (fun args ->
|
||||
match args with
|
||||
| [a] -> Number (Float.round (as_number a))
|
||||
| [a; b] ->
|
||||
let n = as_number a and places = int_of_float (as_number b) in
|
||||
let factor = 10.0 ** float_of_int places in
|
||||
Number (Float.round (n *. factor) /. factor)
|
||||
| _ -> raise (Eval_error "round: 1-2 args"));
|
||||
register "min" (fun args ->
|
||||
match args with
|
||||
| [] -> raise (Eval_error "min: at least 1 arg")
|
||||
| _ -> Number (List.fold_left (fun acc a -> Float.min acc (as_number a)) Float.infinity args));
|
||||
register "max" (fun args ->
|
||||
match args with
|
||||
| [] -> raise (Eval_error "max: at least 1 arg")
|
||||
| _ -> Number (List.fold_left (fun acc a -> Float.max acc (as_number a)) Float.neg_infinity args));
|
||||
register "sqrt" (fun args ->
|
||||
match args with [a] -> Number (Float.sqrt (as_number a)) | _ -> raise (Eval_error "sqrt: 1 arg"));
|
||||
register "pow" (fun args ->
|
||||
match args with [a; b] -> Number (as_number a ** as_number b)
|
||||
| _ -> raise (Eval_error "pow: 2 args"));
|
||||
register "clamp" (fun args ->
|
||||
match args with
|
||||
| [x; lo; hi] ->
|
||||
let x = as_number x and lo = as_number lo and hi = as_number hi in
|
||||
Number (Float.max lo (Float.min hi x))
|
||||
| _ -> raise (Eval_error "clamp: 3 args"));
|
||||
register "parse-int" (fun args ->
|
||||
match args with
|
||||
| [String s] -> (match int_of_string_opt s with Some n -> Number (float_of_int n) | None -> Nil)
|
||||
| [Number n] -> Number (float_of_int (int_of_float n))
|
||||
| _ -> Nil);
|
||||
register "parse-float" (fun args ->
|
||||
match args with
|
||||
| [String s] -> (match float_of_string_opt s with Some n -> Number n | None -> Nil)
|
||||
| [Number n] -> Number n
|
||||
| _ -> Nil);
|
||||
|
||||
(* === Comparison === *)
|
||||
(* Normalize ListRef to List for structural equality *)
|
||||
let rec normalize_for_eq = function
|
||||
| ListRef { contents = items } -> List (List.map normalize_for_eq items)
|
||||
| List items -> List (List.map normalize_for_eq items)
|
||||
| v -> v
|
||||
in
|
||||
register "=" (fun args ->
|
||||
match args with
|
||||
| [a; b] -> Bool (normalize_for_eq a = normalize_for_eq b)
|
||||
| _ -> raise (Eval_error "=: 2 args"));
|
||||
register "!=" (fun args ->
|
||||
match args with
|
||||
| [a; b] -> Bool (normalize_for_eq a <> normalize_for_eq b)
|
||||
| _ -> raise (Eval_error "!=: 2 args"));
|
||||
register "<" (fun args ->
|
||||
match args with
|
||||
| [String a; String b] -> Bool (a < b)
|
||||
| [a; b] -> Bool (as_number a < as_number b)
|
||||
| _ -> raise (Eval_error "<: 2 args"));
|
||||
register ">" (fun args ->
|
||||
match args with
|
||||
| [String a; String b] -> Bool (a > b)
|
||||
| [a; b] -> Bool (as_number a > as_number b)
|
||||
| _ -> raise (Eval_error ">: 2 args"));
|
||||
register "<=" (fun args ->
|
||||
match args with
|
||||
| [String a; String b] -> Bool (a <= b)
|
||||
| [a; b] -> Bool (as_number a <= as_number b)
|
||||
| _ -> raise (Eval_error "<=: 2 args"));
|
||||
register ">=" (fun args ->
|
||||
match args with
|
||||
| [String a; String b] -> Bool (a >= b)
|
||||
| [a; b] -> Bool (as_number a >= as_number b)
|
||||
| _ -> raise (Eval_error ">=: 2 args"));
|
||||
|
||||
(* === Logic === *)
|
||||
register "not" (fun args ->
|
||||
match args with [a] -> Bool (not (sx_truthy a)) | _ -> raise (Eval_error "not: 1 arg"));
|
||||
|
||||
(* === Predicates === *)
|
||||
register "nil?" (fun args ->
|
||||
match args with [a] -> Bool (is_nil a) | _ -> raise (Eval_error "nil?: 1 arg"));
|
||||
register "number?" (fun args ->
|
||||
match args with [Number _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "number?: 1 arg"));
|
||||
register "string?" (fun args ->
|
||||
match args with [String _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "string?: 1 arg"));
|
||||
register "boolean?" (fun args ->
|
||||
match args with [Bool _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "boolean?: 1 arg"));
|
||||
register "list?" (fun args ->
|
||||
match args with [List _] | [ListRef _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "list?: 1 arg"));
|
||||
register "dict?" (fun args ->
|
||||
match args with [Dict _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "dict?: 1 arg"));
|
||||
register "symbol?" (fun args ->
|
||||
match args with [Symbol _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "symbol?: 1 arg"));
|
||||
register "keyword?" (fun args ->
|
||||
match args with [Keyword _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "keyword?: 1 arg"));
|
||||
register "empty?" (fun args ->
|
||||
match args with
|
||||
| [List []] | [ListRef { contents = [] }] -> Bool true
|
||||
| [List _] | [ListRef _] -> Bool false
|
||||
| [String ""] -> Bool true | [String _] -> Bool false
|
||||
| [Dict d] -> Bool (Hashtbl.length d = 0)
|
||||
| [Nil] -> Bool true
|
||||
| [_] -> Bool false
|
||||
| _ -> raise (Eval_error "empty?: 1 arg"));
|
||||
register "odd?" (fun args ->
|
||||
match args with [a] -> Bool (int_of_float (as_number a) mod 2 <> 0) | _ -> raise (Eval_error "odd?: 1 arg"));
|
||||
register "even?" (fun args ->
|
||||
match args with [a] -> Bool (int_of_float (as_number a) mod 2 = 0) | _ -> raise (Eval_error "even?: 1 arg"));
|
||||
register "zero?" (fun args ->
|
||||
match args with [a] -> Bool (as_number a = 0.0) | _ -> raise (Eval_error "zero?: 1 arg"));
|
||||
|
||||
(* === Strings === *)
|
||||
register "str" (fun args -> String (String.concat "" (List.map to_string args)));
|
||||
register "upper" (fun args ->
|
||||
match args with [a] -> String (String.uppercase_ascii (as_string a)) | _ -> raise (Eval_error "upper: 1 arg"));
|
||||
register "upcase" (fun args ->
|
||||
match args with [a] -> String (String.uppercase_ascii (as_string a)) | _ -> raise (Eval_error "upcase: 1 arg"));
|
||||
register "lower" (fun args ->
|
||||
match args with [a] -> String (String.lowercase_ascii (as_string a)) | _ -> raise (Eval_error "lower: 1 arg"));
|
||||
register "downcase" (fun args ->
|
||||
match args with [a] -> String (String.lowercase_ascii (as_string a)) | _ -> raise (Eval_error "downcase: 1 arg"));
|
||||
register "trim" (fun args ->
|
||||
match args with [a] -> String (String.trim (as_string a)) | _ -> raise (Eval_error "trim: 1 arg"));
|
||||
register "string-length" (fun args ->
|
||||
match args with [a] -> Number (float_of_int (String.length (as_string a)))
|
||||
| _ -> raise (Eval_error "string-length: 1 arg"));
|
||||
register "string-contains?" (fun args ->
|
||||
match args with
|
||||
| [String haystack; String needle] ->
|
||||
let rec find i =
|
||||
if i + String.length needle > String.length haystack then false
|
||||
else if String.sub haystack i (String.length needle) = needle then true
|
||||
else find (i + 1)
|
||||
in Bool (find 0)
|
||||
| _ -> raise (Eval_error "string-contains?: 2 string args"));
|
||||
register "starts-with?" (fun args ->
|
||||
match args with
|
||||
| [String s; String prefix] ->
|
||||
Bool (String.length s >= String.length prefix &&
|
||||
String.sub s 0 (String.length prefix) = prefix)
|
||||
| _ -> raise (Eval_error "starts-with?: 2 string args"));
|
||||
register "ends-with?" (fun args ->
|
||||
match args with
|
||||
| [String s; String suffix] ->
|
||||
let sl = String.length s and xl = String.length suffix in
|
||||
Bool (sl >= xl && String.sub s (sl - xl) xl = suffix)
|
||||
| _ -> raise (Eval_error "ends-with?: 2 string args"));
|
||||
register "index-of" (fun args ->
|
||||
match args with
|
||||
| [String haystack; String needle] ->
|
||||
let nl = String.length needle and hl = String.length haystack in
|
||||
let rec find i =
|
||||
if i + nl > hl then Number (-1.0)
|
||||
else if String.sub haystack i nl = needle then Number (float_of_int i)
|
||||
else find (i + 1)
|
||||
in find 0
|
||||
| _ -> raise (Eval_error "index-of: 2 string args"));
|
||||
register "substring" (fun args ->
|
||||
match args with
|
||||
| [String s; Number start; Number end_] ->
|
||||
let i = int_of_float start and j = int_of_float end_ in
|
||||
let len = String.length s in
|
||||
let i = max 0 (min i len) and j = max 0 (min j len) in
|
||||
String (String.sub s i (max 0 (j - i)))
|
||||
| _ -> raise (Eval_error "substring: 3 args"));
|
||||
register "substr" (fun args ->
|
||||
match args with
|
||||
| [String s; Number start; Number len] ->
|
||||
let i = int_of_float start and n = int_of_float len in
|
||||
let sl = String.length s in
|
||||
let i = max 0 (min i sl) in
|
||||
let n = max 0 (min n (sl - i)) in
|
||||
String (String.sub s i n)
|
||||
| [String s; Number start] ->
|
||||
let i = int_of_float start in
|
||||
let sl = String.length s in
|
||||
let i = max 0 (min i sl) in
|
||||
String (String.sub s i (sl - i))
|
||||
| _ -> raise (Eval_error "substr: 2-3 args"));
|
||||
register "split" (fun args ->
|
||||
match args with
|
||||
| [String s; String sep] ->
|
||||
List (List.map (fun p -> String p) (String.split_on_char sep.[0] s))
|
||||
| _ -> raise (Eval_error "split: 2 args"));
|
||||
register "join" (fun args ->
|
||||
match args with
|
||||
| [String sep; (List items | ListRef { contents = items })] ->
|
||||
String (String.concat sep (List.map to_string items))
|
||||
| _ -> raise (Eval_error "join: 2 args"));
|
||||
register "replace" (fun args ->
|
||||
match args with
|
||||
| [String s; String old_s; String new_s] ->
|
||||
let ol = String.length old_s in
|
||||
if ol = 0 then String s
|
||||
else begin
|
||||
let buf = Buffer.create (String.length s) in
|
||||
let rec go i =
|
||||
if i >= String.length s then ()
|
||||
else if i + ol <= String.length s && String.sub s i ol = old_s then begin
|
||||
Buffer.add_string buf new_s;
|
||||
go (i + ol)
|
||||
end else begin
|
||||
Buffer.add_char buf s.[i];
|
||||
go (i + 1)
|
||||
end
|
||||
in go 0;
|
||||
String (Buffer.contents buf)
|
||||
end
|
||||
| _ -> raise (Eval_error "replace: 3 string args"));
|
||||
register "char-from-code" (fun args ->
|
||||
match args with
|
||||
| [Number n] ->
|
||||
let buf = Buffer.create 4 in
|
||||
Buffer.add_utf_8_uchar buf (Uchar.of_int (int_of_float n));
|
||||
String (Buffer.contents buf)
|
||||
| _ -> raise (Eval_error "char-from-code: 1 arg"));
|
||||
|
||||
(* === Collections === *)
|
||||
register "list" (fun args -> ListRef (ref args));
|
||||
register "len" (fun args ->
|
||||
match args with
|
||||
| [List l] | [ListRef { contents = l }] -> Number (float_of_int (List.length l))
|
||||
| [String s] -> Number (float_of_int (String.length s))
|
||||
| [Dict d] -> Number (float_of_int (Hashtbl.length d))
|
||||
| [Nil] -> Number 0.0
|
||||
| _ -> raise (Eval_error "len: 1 arg"));
|
||||
register "first" (fun args ->
|
||||
match args with
|
||||
| [List (x :: _)] | [ListRef { contents = x :: _ }] -> x
|
||||
| [List []] | [ListRef { contents = [] }] -> Nil | [Nil] -> Nil
|
||||
| _ -> raise (Eval_error "first: 1 list arg"));
|
||||
register "rest" (fun args ->
|
||||
match args with
|
||||
| [List (_ :: xs)] | [ListRef { contents = _ :: xs }] -> List xs
|
||||
| [List []] | [ListRef { contents = [] }] -> List [] | [Nil] -> List []
|
||||
| _ -> raise (Eval_error "rest: 1 list arg"));
|
||||
register "last" (fun args ->
|
||||
match args with
|
||||
| [List l] | [ListRef { contents = l }] ->
|
||||
(match List.rev l with x :: _ -> x | [] -> Nil)
|
||||
| _ -> raise (Eval_error "last: 1 list arg"));
|
||||
register "nth" (fun args ->
|
||||
match args with
|
||||
| [List l; Number n] | [ListRef { contents = l }; Number n] ->
|
||||
(try List.nth l (int_of_float n) with _ -> Nil)
|
||||
| _ -> raise (Eval_error "nth: list and number"));
|
||||
register "cons" (fun args ->
|
||||
match args with
|
||||
| [x; List l] | [x; ListRef { contents = l }] -> List (x :: l)
|
||||
| [x; Nil] -> List [x]
|
||||
| _ -> raise (Eval_error "cons: value and list"));
|
||||
register "append" (fun args ->
|
||||
let all = List.concat_map (fun a -> as_list a) args in
|
||||
List all);
|
||||
register "reverse" (fun args ->
|
||||
match args with
|
||||
| [List l] | [ListRef { contents = l }] -> List (List.rev l)
|
||||
| _ -> raise (Eval_error "reverse: 1 list"));
|
||||
register "flatten" (fun args ->
|
||||
let rec flat = function
|
||||
| List items | ListRef { contents = items } -> List.concat_map flat items
|
||||
| x -> [x]
|
||||
in
|
||||
match args with
|
||||
| [List l] | [ListRef { contents = l }] -> List (List.concat_map flat l)
|
||||
| _ -> raise (Eval_error "flatten: 1 list"));
|
||||
register "concat" (fun args -> List (List.concat_map as_list args));
|
||||
register "contains?" (fun args ->
|
||||
match args with
|
||||
| [List l; item] | [ListRef { contents = l }; item] -> Bool (List.mem item l)
|
||||
| [String s; String sub] ->
|
||||
let rec find i =
|
||||
if i + String.length sub > String.length s then false
|
||||
else if String.sub s i (String.length sub) = sub then true
|
||||
else find (i + 1)
|
||||
in Bool (find 0)
|
||||
| _ -> raise (Eval_error "contains?: 2 args"));
|
||||
register "range" (fun args ->
|
||||
match args with
|
||||
| [Number stop] ->
|
||||
let n = int_of_float stop in
|
||||
List (List.init (max 0 n) (fun i -> Number (float_of_int i)))
|
||||
| [Number start; Number stop] ->
|
||||
let s = int_of_float start and e = int_of_float stop in
|
||||
let len = max 0 (e - s) in
|
||||
List (List.init len (fun i -> Number (float_of_int (s + i))))
|
||||
| [Number start; Number stop; Number step] ->
|
||||
let s = start and e = stop and st = step in
|
||||
if st = 0.0 then List []
|
||||
else
|
||||
let items = ref [] in
|
||||
let i = ref s in
|
||||
if st > 0.0 then
|
||||
(while !i < e do items := Number !i :: !items; i := !i +. st done)
|
||||
else
|
||||
(while !i > e do items := Number !i :: !items; i := !i +. st done);
|
||||
List (List.rev !items)
|
||||
| _ -> raise (Eval_error "range: 1-3 args"));
|
||||
register "slice" (fun args ->
|
||||
match args with
|
||||
| [(List l | ListRef { contents = l }); Number start] ->
|
||||
let i = max 0 (int_of_float start) in
|
||||
let rec drop n = function _ :: xs when n > 0 -> drop (n-1) xs | l -> l in
|
||||
List (drop i l)
|
||||
| [(List l | ListRef { contents = l }); Number start; Number end_] ->
|
||||
let i = max 0 (int_of_float start) and j = int_of_float end_ in
|
||||
let len = List.length l in
|
||||
let j = min j len in
|
||||
let rec take_range idx = function
|
||||
| [] -> []
|
||||
| x :: xs ->
|
||||
if idx >= j then []
|
||||
else if idx >= i then x :: take_range (idx+1) xs
|
||||
else take_range (idx+1) xs
|
||||
in List (take_range 0 l)
|
||||
| [String s; Number start] ->
|
||||
let i = max 0 (int_of_float start) in
|
||||
String (String.sub s i (max 0 (String.length s - i)))
|
||||
| [String s; Number start; Number end_] ->
|
||||
let i = max 0 (int_of_float start) and j = int_of_float end_ in
|
||||
let sl = String.length s in
|
||||
let j = min j sl in
|
||||
String (String.sub s i (max 0 (j - i)))
|
||||
| _ -> raise (Eval_error "slice: 2-3 args"));
|
||||
register "sort" (fun args ->
|
||||
match args with
|
||||
| [List l] | [ListRef { contents = l }] -> List (List.sort compare l)
|
||||
| _ -> raise (Eval_error "sort: 1 list"));
|
||||
register "zip" (fun args ->
|
||||
match args with
|
||||
| [a; b] ->
|
||||
let la = as_list a and lb = as_list b in
|
||||
let rec go l1 l2 acc = match l1, l2 with
|
||||
| x :: xs, y :: ys -> go xs ys (List [x; y] :: acc)
|
||||
| _ -> List.rev acc
|
||||
in List (go la lb [])
|
||||
| _ -> raise (Eval_error "zip: 2 lists"));
|
||||
register "zip-pairs" (fun args ->
|
||||
match args with
|
||||
| [v] ->
|
||||
let l = as_list v in
|
||||
let rec go = function
|
||||
| a :: b :: rest -> List [a; b] :: go rest
|
||||
| _ -> []
|
||||
in List (go l)
|
||||
| _ -> raise (Eval_error "zip-pairs: 1 list"));
|
||||
register "take" (fun args ->
|
||||
match args with
|
||||
| [(List l | ListRef { contents = l }); Number n] ->
|
||||
let rec take_n i = function
|
||||
| x :: xs when i > 0 -> x :: take_n (i-1) xs
|
||||
| _ -> []
|
||||
in List (take_n (int_of_float n) l)
|
||||
| _ -> raise (Eval_error "take: list and number"));
|
||||
register "drop" (fun args ->
|
||||
match args with
|
||||
| [(List l | ListRef { contents = l }); Number n] ->
|
||||
let rec drop_n i = function
|
||||
| _ :: xs when i > 0 -> drop_n (i-1) xs
|
||||
| l -> l
|
||||
in List (drop_n (int_of_float n) l)
|
||||
| _ -> raise (Eval_error "drop: list and number"));
|
||||
register "chunk-every" (fun args ->
|
||||
match args with
|
||||
| [(List l | ListRef { contents = l }); Number n] ->
|
||||
let size = int_of_float n in
|
||||
let rec go = function
|
||||
| [] -> []
|
||||
| l ->
|
||||
let rec take_n i = function
|
||||
| x :: xs when i > 0 -> x :: take_n (i-1) xs
|
||||
| _ -> []
|
||||
in
|
||||
let rec drop_n i = function
|
||||
| _ :: xs when i > 0 -> drop_n (i-1) xs
|
||||
| l -> l
|
||||
in
|
||||
List (take_n size l) :: go (drop_n size l)
|
||||
in List (go l)
|
||||
| _ -> raise (Eval_error "chunk-every: list and number"));
|
||||
register "unique" (fun args ->
|
||||
match args with
|
||||
| [(List l | ListRef { contents = l })] ->
|
||||
let seen = Hashtbl.create 16 in
|
||||
let result = List.filter (fun x ->
|
||||
let key = inspect x in
|
||||
if Hashtbl.mem seen key then false
|
||||
else (Hashtbl.replace seen key true; true)
|
||||
) l in
|
||||
List result
|
||||
| _ -> raise (Eval_error "unique: 1 list"));
|
||||
|
||||
(* === Dict === *)
|
||||
register "dict" (fun args ->
|
||||
let d = make_dict () in
|
||||
let rec go = function
|
||||
| [] -> Dict d
|
||||
| Keyword k :: v :: rest -> dict_set d k v; go rest
|
||||
| String k :: v :: rest -> dict_set d k v; go rest
|
||||
| _ -> raise (Eval_error "dict: pairs of key value")
|
||||
in go args);
|
||||
register "get" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k] -> dict_get d k
|
||||
| [Dict d; Keyword k] -> dict_get d k
|
||||
| [List l; Number n] | [ListRef { contents = l }; Number n] ->
|
||||
(try List.nth l (int_of_float n) with _ -> Nil)
|
||||
| _ -> raise (Eval_error "get: dict+key or list+index"));
|
||||
register "has-key?" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k] -> Bool (dict_has d k)
|
||||
| [Dict d; Keyword k] -> Bool (dict_has d k)
|
||||
| _ -> raise (Eval_error "has-key?: dict and key"));
|
||||
register "assoc" (fun args ->
|
||||
match args with
|
||||
| Dict d :: rest ->
|
||||
let d2 = Hashtbl.copy d in
|
||||
let rec go = function
|
||||
| [] -> Dict d2
|
||||
| String k :: v :: rest -> Hashtbl.replace d2 k v; go rest
|
||||
| Keyword k :: v :: rest -> Hashtbl.replace d2 k v; go rest
|
||||
| _ -> raise (Eval_error "assoc: pairs")
|
||||
in go rest
|
||||
| _ -> raise (Eval_error "assoc: dict + pairs"));
|
||||
register "dissoc" (fun args ->
|
||||
match args with
|
||||
| Dict d :: keys ->
|
||||
let d2 = Hashtbl.copy d in
|
||||
List.iter (fun k -> Hashtbl.remove d2 (to_string k)) keys;
|
||||
Dict d2
|
||||
| _ -> raise (Eval_error "dissoc: dict + keys"));
|
||||
register "merge" (fun args ->
|
||||
let d = make_dict () in
|
||||
List.iter (function
|
||||
| Dict src -> Hashtbl.iter (fun k v -> Hashtbl.replace d k v) src
|
||||
| _ -> raise (Eval_error "merge: all args must be dicts")
|
||||
) args;
|
||||
Dict d);
|
||||
register "keys" (fun args ->
|
||||
match args with [Dict d] -> List (dict_keys d) | _ -> raise (Eval_error "keys: 1 dict"));
|
||||
register "vals" (fun args ->
|
||||
match args with [Dict d] -> List (dict_vals d) | _ -> raise (Eval_error "vals: 1 dict"));
|
||||
register "dict-set!" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k; v] -> dict_set d k v; v
|
||||
| [Dict d; Keyword k; v] -> dict_set d k v; v
|
||||
| _ -> raise (Eval_error "dict-set!: dict key val"));
|
||||
register "dict-get" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k] -> dict_get d k
|
||||
| [Dict d; Keyword k] -> dict_get d k
|
||||
| _ -> raise (Eval_error "dict-get: dict and key"));
|
||||
register "dict-has?" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k] -> Bool (dict_has d k)
|
||||
| _ -> raise (Eval_error "dict-has?: dict and key"));
|
||||
register "dict-delete!" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k] -> dict_delete d k; Nil
|
||||
| _ -> raise (Eval_error "dict-delete!: dict and key"));
|
||||
|
||||
(* === Misc === *)
|
||||
register "type-of" (fun args ->
|
||||
match args with [a] -> String (type_of a) | _ -> raise (Eval_error "type-of: 1 arg"));
|
||||
register "inspect" (fun args ->
|
||||
match args with [a] -> String (inspect a) | _ -> raise (Eval_error "inspect: 1 arg"));
|
||||
register "error" (fun args ->
|
||||
match args with [String msg] -> raise (Eval_error msg)
|
||||
| [a] -> raise (Eval_error (to_string a))
|
||||
| _ -> raise (Eval_error "error: 1 arg"));
|
||||
register "apply" (fun args ->
|
||||
match args with
|
||||
| [NativeFn (_, f); List a] -> f a
|
||||
| _ -> raise (Eval_error "apply: function and list"));
|
||||
register "identical?" (fun args ->
|
||||
match args with [a; b] -> Bool (a == b) | _ -> raise (Eval_error "identical?: 2 args"));
|
||||
register "make-spread" (fun args ->
|
||||
match args with
|
||||
| [Dict d] ->
|
||||
let pairs = Hashtbl.fold (fun k v acc -> (k, v) :: acc) d [] in
|
||||
Spread pairs
|
||||
| _ -> raise (Eval_error "make-spread: 1 dict"));
|
||||
register "spread?" (fun args ->
|
||||
match args with [Spread _] -> Bool true | [_] -> Bool false
|
||||
| _ -> raise (Eval_error "spread?: 1 arg"));
|
||||
register "spread-attrs" (fun args ->
|
||||
match args with
|
||||
| [Spread pairs] ->
|
||||
let d = make_dict () in
|
||||
List.iter (fun (k, v) -> dict_set d k v) pairs;
|
||||
Dict d
|
||||
| _ -> raise (Eval_error "spread-attrs: 1 spread"));
|
||||
()
|
||||
573
hosts/ocaml/lib/sx_ref.ml
Normal file
573
hosts/ocaml/lib/sx_ref.ml
Normal file
File diff suppressed because one or more lines are too long
435
hosts/ocaml/lib/sx_render.ml
Normal file
435
hosts/ocaml/lib/sx_render.ml
Normal file
@@ -0,0 +1,435 @@
|
||||
(** HTML renderer for SX values.
|
||||
|
||||
Extracted from run_tests.ml — renders an SX expression tree to an
|
||||
HTML string, expanding components and macros along the way.
|
||||
|
||||
Depends on [Sx_ref.eval_expr] for evaluating sub-expressions
|
||||
during rendering (keyword arg values, conditionals, etc.). *)
|
||||
|
||||
open Sx_types
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Tag / attribute registries *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let html_tags = [
|
||||
"html"; "head"; "body"; "title"; "meta"; "link"; "script"; "style"; "noscript";
|
||||
"header"; "nav"; "main"; "section"; "article"; "aside"; "footer";
|
||||
"h1"; "h2"; "h3"; "h4"; "h5"; "h6"; "hgroup";
|
||||
"div"; "p"; "blockquote"; "pre"; "figure"; "figcaption"; "address"; "hr";
|
||||
"ul"; "ol"; "li"; "dl"; "dt"; "dd"; "menu";
|
||||
"a"; "span"; "em"; "strong"; "small"; "b"; "i"; "u"; "s"; "sub"; "sup";
|
||||
"mark"; "del"; "ins"; "q"; "cite"; "dfn"; "abbr"; "code"; "var"; "samp";
|
||||
"kbd"; "data"; "time"; "ruby"; "rt"; "rp"; "bdi"; "bdo"; "wbr"; "br";
|
||||
"table"; "thead"; "tbody"; "tfoot"; "tr"; "th"; "td"; "caption"; "colgroup"; "col";
|
||||
"form"; "input"; "textarea"; "select"; "option"; "optgroup"; "button"; "label";
|
||||
"fieldset"; "legend"; "datalist"; "output"; "progress"; "meter";
|
||||
"details"; "summary"; "dialog";
|
||||
"img"; "video"; "audio"; "source"; "picture"; "canvas"; "iframe"; "embed"; "object"; "param";
|
||||
"svg"; "path"; "circle"; "rect"; "line"; "polyline"; "polygon"; "ellipse";
|
||||
"g"; "defs"; "use"; "text"; "tspan"; "clipPath"; "mask"; "pattern";
|
||||
"linearGradient"; "radialGradient"; "stop"; "filter"; "feBlend"; "feFlood";
|
||||
"feGaussianBlur"; "feOffset"; "feMerge"; "feMergeNode"; "feComposite";
|
||||
"template"; "slot";
|
||||
]
|
||||
|
||||
let void_elements = [
|
||||
"area"; "base"; "br"; "col"; "embed"; "hr"; "img"; "input";
|
||||
"link"; "meta"; "param"; "source"; "track"; "wbr"
|
||||
]
|
||||
|
||||
let boolean_attrs = [
|
||||
"async"; "autofocus"; "autoplay"; "checked"; "controls"; "default";
|
||||
"defer"; "disabled"; "formnovalidate"; "hidden"; "inert"; "ismap";
|
||||
"loop"; "multiple"; "muted"; "nomodule"; "novalidate"; "open";
|
||||
"playsinline"; "readonly"; "required"; "reversed"; "selected"
|
||||
]
|
||||
|
||||
let is_html_tag name = List.mem name html_tags
|
||||
let is_void name = List.mem name void_elements
|
||||
let is_boolean_attr name = List.mem name boolean_attrs
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* HTML escaping *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let escape_html s =
|
||||
let buf = Buffer.create (String.length s) in
|
||||
String.iter (function
|
||||
| '&' -> Buffer.add_string buf "&"
|
||||
| '<' -> Buffer.add_string buf "<"
|
||||
| '>' -> Buffer.add_string buf ">"
|
||||
| '"' -> Buffer.add_string buf """
|
||||
| c -> Buffer.add_char buf c) s;
|
||||
Buffer.contents buf
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Attribute rendering *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let render_attrs attrs =
|
||||
let buf = Buffer.create 64 in
|
||||
Hashtbl.iter (fun k v ->
|
||||
if is_boolean_attr k then begin
|
||||
if sx_truthy v then begin
|
||||
Buffer.add_char buf ' ';
|
||||
Buffer.add_string buf k
|
||||
end
|
||||
end else if not (is_nil v) then begin
|
||||
Buffer.add_char buf ' ';
|
||||
Buffer.add_string buf k;
|
||||
Buffer.add_string buf "=\"";
|
||||
Buffer.add_string buf (escape_html (value_to_string v));
|
||||
Buffer.add_char buf '"'
|
||||
end) attrs;
|
||||
Buffer.contents buf
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* HTML renderer *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
(* Forward ref — resolved at setup time *)
|
||||
let render_to_html_ref : (value -> env -> string) ref =
|
||||
ref (fun _expr _env -> "")
|
||||
|
||||
let render_to_html expr env = !render_to_html_ref expr env
|
||||
|
||||
let render_children children env =
|
||||
String.concat "" (List.map (fun c -> render_to_html c env) children)
|
||||
|
||||
(** Parse keyword attrs and positional children from an element call's args.
|
||||
Attrs are evaluated; children are returned UNEVALUATED for render dispatch. *)
|
||||
let parse_element_args args env =
|
||||
let attrs = Hashtbl.create 8 in
|
||||
let children = ref [] in
|
||||
let skip = ref false in
|
||||
let len = List.length args in
|
||||
List.iteri (fun idx arg ->
|
||||
if !skip then skip := false
|
||||
else match arg with
|
||||
| Keyword k when idx + 1 < len ->
|
||||
let v = Sx_ref.eval_expr (List.nth args (idx + 1)) (Env env) in
|
||||
Hashtbl.replace attrs k v;
|
||||
skip := true
|
||||
| Spread pairs ->
|
||||
List.iter (fun (k, v) -> Hashtbl.replace attrs k v) pairs
|
||||
| _ ->
|
||||
children := arg :: !children
|
||||
) args;
|
||||
(attrs, List.rev !children)
|
||||
|
||||
let render_html_element tag args env =
|
||||
let (attrs, children) = parse_element_args args env in
|
||||
let attr_str = render_attrs attrs in
|
||||
if is_void tag then
|
||||
"<" ^ tag ^ attr_str ^ " />"
|
||||
else
|
||||
let content = String.concat ""
|
||||
(List.map (fun c -> render_to_html c env) children) in
|
||||
"<" ^ tag ^ attr_str ^ ">" ^ content ^ "</" ^ tag ^ ">"
|
||||
|
||||
let render_component comp args env =
|
||||
match comp with
|
||||
| Component c ->
|
||||
let kwargs = Hashtbl.create 8 in
|
||||
let children_exprs = ref [] in
|
||||
let skip = ref false in
|
||||
let len = List.length args in
|
||||
List.iteri (fun idx arg ->
|
||||
if !skip then skip := false
|
||||
else match arg with
|
||||
| Keyword k when idx + 1 < len ->
|
||||
let v = Sx_ref.eval_expr (List.nth args (idx + 1)) (Env env) in
|
||||
Hashtbl.replace kwargs k v;
|
||||
skip := true
|
||||
| _ ->
|
||||
children_exprs := arg :: !children_exprs
|
||||
) args;
|
||||
let children = List.rev !children_exprs in
|
||||
let local = env_merge c.c_closure env in
|
||||
List.iter (fun p ->
|
||||
let v = match Hashtbl.find_opt kwargs p with Some v -> v | None -> Nil in
|
||||
ignore (env_bind local p v)
|
||||
) c.c_params;
|
||||
if c.c_has_children then begin
|
||||
let rendered_children = String.concat ""
|
||||
(List.map (fun c -> render_to_html c env) children) in
|
||||
ignore (env_bind local "children" (RawHTML rendered_children))
|
||||
end;
|
||||
render_to_html c.c_body local
|
||||
| _ -> ""
|
||||
|
||||
let expand_macro (m : macro) args _env =
|
||||
let local = env_extend m.m_closure in
|
||||
let params = m.m_params in
|
||||
let rec bind_params ps as' =
|
||||
match ps, as' with
|
||||
| [], rest ->
|
||||
(match m.m_rest_param with
|
||||
| Some rp -> ignore (env_bind local rp (List rest))
|
||||
| None -> ())
|
||||
| p :: ps_rest, a :: as_rest ->
|
||||
ignore (env_bind local p a);
|
||||
bind_params ps_rest as_rest
|
||||
| _ :: _, [] ->
|
||||
List.iter (fun p -> ignore (env_bind local p Nil)) (List.rev ps)
|
||||
in
|
||||
bind_params params args;
|
||||
Sx_ref.eval_expr m.m_body (Env local)
|
||||
|
||||
let rec do_render_to_html (expr : value) (env : env) : string =
|
||||
match expr with
|
||||
| Nil -> ""
|
||||
| Bool true -> "true"
|
||||
| Bool false -> "false"
|
||||
| Number n ->
|
||||
if Float.is_integer n then string_of_int (int_of_float n)
|
||||
else Printf.sprintf "%g" n
|
||||
| String s -> escape_html s
|
||||
| Keyword k -> escape_html k
|
||||
| RawHTML s -> s
|
||||
| Symbol s ->
|
||||
let v = Sx_ref.eval_expr (Symbol s) (Env env) in
|
||||
do_render_to_html v env
|
||||
| List [] | ListRef { contents = [] } -> ""
|
||||
| List (head :: args) | ListRef { contents = head :: args } ->
|
||||
render_list_to_html head args env
|
||||
| _ ->
|
||||
let v = Sx_ref.eval_expr expr (Env env) in
|
||||
do_render_to_html v env
|
||||
|
||||
and render_list_to_html head args env =
|
||||
match head with
|
||||
| Symbol "<>" ->
|
||||
render_children args env
|
||||
| Symbol tag when is_html_tag tag ->
|
||||
render_html_element tag args env
|
||||
| Symbol "if" ->
|
||||
let cond_val = Sx_ref.eval_expr (List.hd args) (Env env) in
|
||||
if sx_truthy cond_val then
|
||||
(if List.length args > 1 then do_render_to_html (List.nth args 1) env else "")
|
||||
else
|
||||
(if List.length args > 2 then do_render_to_html (List.nth args 2) env else "")
|
||||
| Symbol "when" ->
|
||||
let cond_val = Sx_ref.eval_expr (List.hd args) (Env env) in
|
||||
if sx_truthy cond_val then
|
||||
String.concat "" (List.map (fun e -> do_render_to_html e env) (List.tl args))
|
||||
else ""
|
||||
| Symbol "cond" ->
|
||||
render_cond args env
|
||||
| Symbol "case" ->
|
||||
let v = Sx_ref.eval_expr (List (head :: args)) (Env env) in
|
||||
do_render_to_html v env
|
||||
| Symbol ("let" | "let*") ->
|
||||
render_let args env
|
||||
| Symbol ("begin" | "do") ->
|
||||
let rec go = function
|
||||
| [] -> ""
|
||||
| [last] -> do_render_to_html last env
|
||||
| e :: rest ->
|
||||
ignore (Sx_ref.eval_expr e (Env env));
|
||||
go rest
|
||||
in go args
|
||||
| Symbol ("define" | "defcomp" | "defmacro" | "defisland") ->
|
||||
ignore (Sx_ref.eval_expr (List (head :: args)) (Env env));
|
||||
""
|
||||
| Symbol "map" ->
|
||||
render_map args env false
|
||||
| Symbol "map-indexed" ->
|
||||
render_map args env true
|
||||
| Symbol "filter" ->
|
||||
let v = Sx_ref.eval_expr (List (head :: args)) (Env env) in
|
||||
do_render_to_html v env
|
||||
| Symbol "for-each" ->
|
||||
render_for_each args env
|
||||
| Symbol name ->
|
||||
(try
|
||||
let v = env_get env name in
|
||||
(match v with
|
||||
| Component _ -> render_component v args env
|
||||
| Macro m ->
|
||||
let expanded = expand_macro m args env in
|
||||
do_render_to_html expanded env
|
||||
| _ ->
|
||||
let result = Sx_ref.eval_expr (List (head :: args)) (Env env) in
|
||||
do_render_to_html result env)
|
||||
with Eval_error _ ->
|
||||
let result = Sx_ref.eval_expr (List (head :: args)) (Env env) in
|
||||
do_render_to_html result env)
|
||||
| _ ->
|
||||
let result = Sx_ref.eval_expr (List (head :: args)) (Env env) in
|
||||
do_render_to_html result env
|
||||
|
||||
and render_cond args env =
|
||||
let as_list = function List l | ListRef { contents = l } -> Some l | _ -> None in
|
||||
let is_scheme = List.for_all (fun a -> match as_list a with
|
||||
| Some items when List.length items = 2 -> true
|
||||
| _ -> false) args
|
||||
in
|
||||
if is_scheme then begin
|
||||
let rec go = function
|
||||
| [] -> ""
|
||||
| clause :: rest ->
|
||||
(match as_list clause with
|
||||
| Some [test; body] ->
|
||||
let is_else = match test with
|
||||
| Keyword "else" -> true
|
||||
| Symbol "else" | Symbol ":else" -> true
|
||||
| _ -> false
|
||||
in
|
||||
if is_else then do_render_to_html body env
|
||||
else
|
||||
let v = Sx_ref.eval_expr test (Env env) in
|
||||
if sx_truthy v then do_render_to_html body env
|
||||
else go rest
|
||||
| _ -> "")
|
||||
in go args
|
||||
end else begin
|
||||
let rec go = function
|
||||
| [] -> ""
|
||||
| [_] -> ""
|
||||
| test :: body :: rest ->
|
||||
let is_else = match test with
|
||||
| Keyword "else" -> true
|
||||
| Symbol "else" | Symbol ":else" -> true
|
||||
| _ -> false
|
||||
in
|
||||
if is_else then do_render_to_html body env
|
||||
else
|
||||
let v = Sx_ref.eval_expr test (Env env) in
|
||||
if sx_truthy v then do_render_to_html body env
|
||||
else go rest
|
||||
in go args
|
||||
end
|
||||
|
||||
and render_let args env =
|
||||
let as_list = function List l | ListRef { contents = l } -> Some l | _ -> None in
|
||||
let bindings_expr = List.hd args in
|
||||
let body = List.tl args in
|
||||
let local = env_extend env in
|
||||
let bindings = match as_list bindings_expr with Some l -> l | None -> [] in
|
||||
let is_scheme = match bindings with
|
||||
| (List _ :: _) | (ListRef _ :: _) -> true
|
||||
| _ -> false
|
||||
in
|
||||
if is_scheme then
|
||||
List.iter (fun b ->
|
||||
match as_list b with
|
||||
| Some [Symbol name; expr] | Some [String name; expr] ->
|
||||
let v = Sx_ref.eval_expr expr (Env local) in
|
||||
ignore (env_bind local name v)
|
||||
| _ -> ()
|
||||
) bindings
|
||||
else begin
|
||||
let rec go = function
|
||||
| [] -> ()
|
||||
| (Symbol name) :: expr :: rest | (String name) :: expr :: rest ->
|
||||
let v = Sx_ref.eval_expr expr (Env local) in
|
||||
ignore (env_bind local name v);
|
||||
go rest
|
||||
| _ -> ()
|
||||
in go bindings
|
||||
end;
|
||||
let rec render_body = function
|
||||
| [] -> ""
|
||||
| [last] -> do_render_to_html last local
|
||||
| e :: rest ->
|
||||
ignore (Sx_ref.eval_expr e (Env local));
|
||||
render_body rest
|
||||
in render_body body
|
||||
|
||||
and render_map args env indexed =
|
||||
let (fn_val, coll_val) = match args with
|
||||
| [a; b] ->
|
||||
let va = Sx_ref.eval_expr a (Env env) in
|
||||
let vb = Sx_ref.eval_expr b (Env env) in
|
||||
(match va, vb with
|
||||
| (Lambda _ | NativeFn _), _ -> (va, vb)
|
||||
| _, (Lambda _ | NativeFn _) -> (vb, va)
|
||||
| _ -> (va, vb))
|
||||
| _ -> (Nil, Nil)
|
||||
in
|
||||
let items = match coll_val with List l | ListRef { contents = l } -> l | _ -> [] in
|
||||
String.concat "" (List.mapi (fun i item ->
|
||||
let call_args = if indexed then [Number (float_of_int i); item] else [item] in
|
||||
match fn_val with
|
||||
| Lambda l ->
|
||||
let local = env_extend l.l_closure in
|
||||
List.iter2 (fun p a -> ignore (env_bind local p a))
|
||||
l.l_params call_args;
|
||||
do_render_to_html l.l_body local
|
||||
| _ ->
|
||||
let result = Sx_runtime.sx_call fn_val call_args in
|
||||
do_render_to_html result env
|
||||
) items)
|
||||
|
||||
and render_for_each args env =
|
||||
let (fn_val, coll_val) = match args with
|
||||
| [a; b] ->
|
||||
let va = Sx_ref.eval_expr a (Env env) in
|
||||
let vb = Sx_ref.eval_expr b (Env env) in
|
||||
(match va, vb with
|
||||
| (Lambda _ | NativeFn _), _ -> (va, vb)
|
||||
| _, (Lambda _ | NativeFn _) -> (vb, va)
|
||||
| _ -> (va, vb))
|
||||
| _ -> (Nil, Nil)
|
||||
in
|
||||
let items = match coll_val with List l | ListRef { contents = l } -> l | _ -> [] in
|
||||
String.concat "" (List.map (fun item ->
|
||||
match fn_val with
|
||||
| Lambda l ->
|
||||
let local = env_extend l.l_closure in
|
||||
List.iter2 (fun p a -> ignore (env_bind local p a))
|
||||
l.l_params [item];
|
||||
do_render_to_html l.l_body local
|
||||
| _ ->
|
||||
let result = Sx_runtime.sx_call fn_val [item] in
|
||||
do_render_to_html result env
|
||||
) items)
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Setup — bind render primitives in an env and wire up the ref *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let setup_render_env env =
|
||||
render_to_html_ref := do_render_to_html;
|
||||
|
||||
let bind name fn =
|
||||
ignore (env_bind env name (NativeFn (name, fn)))
|
||||
in
|
||||
|
||||
bind "render-html" (fun args ->
|
||||
match args with
|
||||
| [String src] ->
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let expr = match exprs with
|
||||
| [e] -> e
|
||||
| [] -> Nil
|
||||
| _ -> List (Symbol "do" :: exprs)
|
||||
in
|
||||
String (render_to_html expr env)
|
||||
| [expr] ->
|
||||
String (render_to_html expr env)
|
||||
| [expr; Env e] ->
|
||||
String (render_to_html expr e)
|
||||
| _ -> String "");
|
||||
|
||||
bind "render-to-html" (fun args ->
|
||||
match args with
|
||||
| [String src] ->
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let expr = match exprs with
|
||||
| [e] -> e
|
||||
| [] -> Nil
|
||||
| _ -> List (Symbol "do" :: exprs)
|
||||
in
|
||||
String (render_to_html expr env)
|
||||
| [expr] ->
|
||||
String (render_to_html expr env)
|
||||
| [expr; Env e] ->
|
||||
String (render_to_html expr e)
|
||||
| _ -> String "")
|
||||
356
hosts/ocaml/lib/sx_runtime.ml
Normal file
356
hosts/ocaml/lib/sx_runtime.ml
Normal file
@@ -0,0 +1,356 @@
|
||||
(** Runtime helpers for transpiled code.
|
||||
|
||||
These bridge the gap between the transpiler's output and the
|
||||
foundation types/primitives. The transpiled evaluator calls these
|
||||
functions directly. *)
|
||||
|
||||
open Sx_types
|
||||
|
||||
(** Call a registered primitive by name. *)
|
||||
let prim_call name args =
|
||||
match Hashtbl.find_opt Sx_primitives.primitives name with
|
||||
| Some f -> f args
|
||||
| None -> raise (Eval_error ("Unknown primitive: " ^ name))
|
||||
|
||||
(** Convert any SX value to an OCaml string (internal). *)
|
||||
let value_to_str = function
|
||||
| String s -> s
|
||||
| Number n ->
|
||||
if Float.is_integer n then string_of_int (int_of_float n)
|
||||
else Printf.sprintf "%g" n
|
||||
| Bool true -> "true"
|
||||
| Bool false -> "false"
|
||||
| Nil -> ""
|
||||
| Symbol s -> s
|
||||
| Keyword k -> k
|
||||
| v -> inspect v
|
||||
|
||||
(** sx_to_string returns a value (String) for transpiled code. *)
|
||||
let sx_to_string v = String (value_to_str v)
|
||||
|
||||
(** String concatenation helper — [sx_str] takes a list of values. *)
|
||||
let sx_str args =
|
||||
String.concat "" (List.map value_to_str args)
|
||||
|
||||
(** Convert a value to a list. *)
|
||||
let sx_to_list = function
|
||||
| List l -> l
|
||||
| ListRef r -> !r
|
||||
| Nil -> []
|
||||
| v -> raise (Eval_error ("Expected list, got " ^ type_of v))
|
||||
|
||||
(** Call an SX callable (lambda, native fn, continuation). *)
|
||||
let sx_call f args =
|
||||
match f with
|
||||
| NativeFn (_, fn) -> fn args
|
||||
| Lambda l ->
|
||||
let local = Sx_types.env_extend l.l_closure in
|
||||
List.iter2 (fun p a -> ignore (Sx_types.env_bind local p a)) l.l_params args;
|
||||
(* Return the body + env for the trampoline to evaluate *)
|
||||
Thunk (l.l_body, local)
|
||||
| Continuation (k, _) ->
|
||||
k (match args with x :: _ -> x | [] -> Nil)
|
||||
| _ -> raise (Eval_error ("Not callable: " ^ inspect f))
|
||||
|
||||
(** Apply a function to a list of args. *)
|
||||
let sx_apply f args_list =
|
||||
sx_call f (sx_to_list args_list)
|
||||
|
||||
(** Mutable append — add item to a list ref or accumulator.
|
||||
In transpiled code, lists that get appended to are mutable refs. *)
|
||||
let sx_append_b lst item =
|
||||
match lst with
|
||||
| List items -> List (items @ [item])
|
||||
| ListRef r -> r := !r @ [item]; lst (* mutate in place, return same ref *)
|
||||
| _ -> raise (Eval_error ("append!: expected list, got " ^ type_of lst))
|
||||
|
||||
(** Mutable dict-set — set key in dict, return value. *)
|
||||
let sx_dict_set_b d k v =
|
||||
match d, k with
|
||||
| Dict tbl, String key -> Hashtbl.replace tbl key v; v
|
||||
| Dict tbl, Keyword key -> Hashtbl.replace tbl key v; v
|
||||
| _ -> raise (Eval_error "dict-set!: expected dict and string key")
|
||||
|
||||
(** Get from dict or list. *)
|
||||
let get_val container key =
|
||||
match container, key with
|
||||
| Dict d, String k -> dict_get d k
|
||||
| Dict d, Keyword k -> dict_get d k
|
||||
| (List l | ListRef { contents = l }), Number n ->
|
||||
(try List.nth l (int_of_float n) with _ -> Nil)
|
||||
| _ -> raise (Eval_error ("get: unsupported " ^ type_of container ^ " / " ^ type_of key))
|
||||
|
||||
(** Register get as a primitive override — transpiled code calls (get d k). *)
|
||||
let () =
|
||||
Sx_primitives.register "get" (fun args ->
|
||||
match args with
|
||||
| [c; k] -> get_val c k
|
||||
| [c; k; default] ->
|
||||
(try
|
||||
let v = get_val c k in
|
||||
if v = Nil then default else v
|
||||
with _ -> default)
|
||||
| _ -> raise (Eval_error "get: 2-3 args"))
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Primitive aliases — top-level functions called by transpiled code *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
(** The transpiled evaluator calls primitives directly by their mangled
|
||||
OCaml name. These aliases delegate to the primitives table so the
|
||||
transpiled code compiles without needing [prim_call] everywhere. *)
|
||||
|
||||
let _prim name = match Hashtbl.find_opt Sx_primitives.primitives name with
|
||||
| Some f -> f | None -> (fun _ -> raise (Eval_error ("Missing prim: " ^ name)))
|
||||
|
||||
(* Collection ops *)
|
||||
let first args = _prim "first" [args]
|
||||
let rest args = _prim "rest" [args]
|
||||
let last args = _prim "last" [args]
|
||||
let nth coll i = _prim "nth" [coll; i]
|
||||
let cons x l = _prim "cons" [x; l]
|
||||
let append a b = _prim "append" [a; b]
|
||||
let reverse l = _prim "reverse" [l]
|
||||
let flatten l = _prim "flatten" [l]
|
||||
let concat a b = _prim "concat" [a; b]
|
||||
let slice a b = _prim "slice" [a; b]
|
||||
let len a = _prim "len" [a]
|
||||
let get a b = get_val a b
|
||||
let sort' a = _prim "sort" [a]
|
||||
let range' a = _prim "range" [a]
|
||||
let unique a = _prim "unique" [a]
|
||||
let zip a b = _prim "zip" [a; b]
|
||||
let zip_pairs a = _prim "zip-pairs" [a]
|
||||
let take a b = _prim "take" [a; b]
|
||||
let drop a b = _prim "drop" [a; b]
|
||||
let chunk_every a b = _prim "chunk-every" [a; b]
|
||||
|
||||
(* Predicates *)
|
||||
let empty_p a = _prim "empty?" [a]
|
||||
let nil_p a = _prim "nil?" [a]
|
||||
let number_p a = _prim "number?" [a]
|
||||
let string_p a = _prim "string?" [a]
|
||||
let boolean_p a = _prim "boolean?" [a]
|
||||
let list_p a = _prim "list?" [a]
|
||||
let dict_p a = _prim "dict?" [a]
|
||||
let symbol_p a = _prim "symbol?" [a]
|
||||
let keyword_p a = _prim "keyword?" [a]
|
||||
let contains_p a b = _prim "contains?" [a; b]
|
||||
let has_key_p a b = _prim "has-key?" [a; b]
|
||||
let starts_with_p a b = _prim "starts-with?" [a; b]
|
||||
let ends_with_p a b = _prim "ends-with?" [a; b]
|
||||
let string_contains_p a b = _prim "string-contains?" [a; b]
|
||||
let odd_p a = _prim "odd?" [a]
|
||||
let even_p a = _prim "even?" [a]
|
||||
let zero_p a = _prim "zero?" [a]
|
||||
|
||||
(* String ops *)
|
||||
let str' args = String (sx_str args)
|
||||
let upper a = _prim "upper" [a]
|
||||
let upcase a = _prim "upcase" [a]
|
||||
let lower a = _prim "lower" [a]
|
||||
let downcase a = _prim "downcase" [a]
|
||||
let trim a = _prim "trim" [a]
|
||||
let split a b = _prim "split" [a; b]
|
||||
let join a b = _prim "join" [a; b]
|
||||
let replace a b c = _prim "replace" [a; b; c]
|
||||
let index_of a b = _prim "index-of" [a; b]
|
||||
let substring a b c = _prim "substring" [a; b; c]
|
||||
let string_length a = _prim "string-length" [a]
|
||||
let char_from_code a = _prim "char-from-code" [a]
|
||||
|
||||
(* Dict ops *)
|
||||
let assoc d k v = _prim "assoc" [d; k; v]
|
||||
let dissoc d k = _prim "dissoc" [d; k]
|
||||
let merge' a b = _prim "merge" [a; b]
|
||||
let keys a = _prim "keys" [a]
|
||||
let vals a = _prim "vals" [a]
|
||||
let dict_set a b c = _prim "dict-set!" [a; b; c]
|
||||
let dict_get a b = _prim "dict-get" [a; b]
|
||||
let dict_has_p a b = _prim "dict-has?" [a; b]
|
||||
let dict_delete a b = _prim "dict-delete!" [a; b]
|
||||
|
||||
(* Math *)
|
||||
let abs' a = _prim "abs" [a]
|
||||
let sqrt' a = _prim "sqrt" [a]
|
||||
let pow' a b = _prim "pow" [a; b]
|
||||
let floor' a = _prim "floor" [a]
|
||||
let ceil' a = _prim "ceil" [a]
|
||||
let round' a = _prim "round" [a]
|
||||
let min' a b = _prim "min" [a; b]
|
||||
let max' a b = _prim "max" [a; b]
|
||||
let clamp a b c = _prim "clamp" [a; b; c]
|
||||
let parse_int a = _prim "parse-int" [a]
|
||||
let parse_float a = _prim "parse-float" [a]
|
||||
|
||||
(* Misc *)
|
||||
let error msg = raise (Eval_error (value_to_str msg))
|
||||
|
||||
(* inspect wrapper — returns String value instead of OCaml string *)
|
||||
let inspect v = String (Sx_types.inspect v)
|
||||
let apply' f args = sx_apply f args
|
||||
let identical_p a b = _prim "identical?" [a; b]
|
||||
let _is_spread_prim a = _prim "spread?" [a]
|
||||
let spread_attrs a = _prim "spread-attrs" [a]
|
||||
let make_spread a = _prim "make-spread" [a]
|
||||
|
||||
(* Scope primitives — delegate to sx_ref.py's shared scope stacks *)
|
||||
let sx_collect a b = prim_call "collect!" [a; b]
|
||||
let sx_collected a = prim_call "collected" [a]
|
||||
let sx_clear_collected a = prim_call "clear-collected!" [a]
|
||||
let sx_emit a b = prim_call "emit!" [a; b]
|
||||
let sx_emitted a = prim_call "emitted" [a]
|
||||
let sx_context a b = prim_call "context" [a; b]
|
||||
|
||||
(* Trampoline — forward-declared in sx_ref.ml, delegates to CEK eval_expr *)
|
||||
(* This is a stub; the real trampoline is wired up in sx_ref.ml after eval_expr is defined *)
|
||||
let trampoline v = v
|
||||
|
||||
(* Value-returning type predicates — the transpiled code passes these through
|
||||
sx_truthy, so they need to return Bool, not OCaml bool. *)
|
||||
(* type_of returns value, not string *)
|
||||
let type_of v = String (Sx_types.type_of v)
|
||||
|
||||
(* Env operations — accept Env-wrapped values and value keys.
|
||||
The transpiled CEK machine stores envs in dicts as Env values. *)
|
||||
let unwrap_env = function
|
||||
| Env e -> e
|
||||
| _ -> raise (Eval_error "Expected env")
|
||||
|
||||
let env_has e name = Bool (Sx_types.env_has (unwrap_env e) (value_to_str name))
|
||||
let env_get e name = Sx_types.env_get (unwrap_env e) (value_to_str name)
|
||||
let env_bind e name v = Sx_types.env_bind (unwrap_env e) (value_to_str name) v
|
||||
let env_set e name v = Sx_types.env_set (unwrap_env e) (value_to_str name) v
|
||||
|
||||
let make_env () = Env (Sx_types.make_env ())
|
||||
let env_extend e = Env (Sx_types.env_extend (unwrap_env e))
|
||||
let env_merge a b = Env (Sx_types.env_merge (unwrap_env a) (unwrap_env b))
|
||||
|
||||
(* set_lambda_name wrapper — accepts value, extracts string *)
|
||||
let set_lambda_name l n = Sx_types.set_lambda_name l (value_to_str n)
|
||||
|
||||
let is_nil v = Bool (Sx_types.is_nil v)
|
||||
let is_thunk v = Bool (Sx_types.is_thunk v)
|
||||
let is_lambda v = Bool (Sx_types.is_lambda v)
|
||||
let is_component v = Bool (Sx_types.is_component v)
|
||||
let is_island v = Bool (Sx_types.is_island v)
|
||||
let is_macro v = Bool (Sx_types.is_macro v)
|
||||
let is_signal v = Bool (Sx_types.is_signal v)
|
||||
let is_callable v = Bool (Sx_types.is_callable v)
|
||||
let is_identical a b = Bool (a == b)
|
||||
let is_primitive name = Bool (Sx_primitives.is_primitive (value_to_str name))
|
||||
let get_primitive name = Sx_primitives.get_primitive (value_to_str name)
|
||||
let is_spread v = match v with Spread _ -> Bool true | _ -> Bool false
|
||||
|
||||
(* Stubs for functions defined in sx_ref.ml — resolved at link time *)
|
||||
(* These are forward-declared here; sx_ref.ml defines the actual implementations *)
|
||||
|
||||
(* strip-prefix *)
|
||||
(* Stubs for evaluator functions — defined in sx_ref.ml but
|
||||
sometimes referenced before their definition via forward calls.
|
||||
These get overridden by the actual transpiled definitions. *)
|
||||
|
||||
let map_indexed fn coll =
|
||||
List (List.mapi (fun i x -> sx_call fn [Number (float_of_int i); x]) (sx_to_list coll))
|
||||
|
||||
let map_dict fn d =
|
||||
match d with
|
||||
| Dict tbl ->
|
||||
let result = Hashtbl.create (Hashtbl.length tbl) in
|
||||
Hashtbl.iter (fun k v -> Hashtbl.replace result k (sx_call fn [String k; v])) tbl;
|
||||
Dict result
|
||||
| _ -> raise (Eval_error "map-dict: expected dict")
|
||||
|
||||
let for_each fn coll =
|
||||
List.iter (fun x -> ignore (sx_call fn [x])) (sx_to_list coll);
|
||||
Nil
|
||||
|
||||
let for_each_indexed fn coll =
|
||||
List.iteri (fun i x -> ignore (sx_call fn [Number (float_of_int i); x])) (sx_to_list coll);
|
||||
Nil
|
||||
|
||||
(* Continuation support *)
|
||||
let continuation_p v = match v with Continuation (_, _) -> Bool true | _ -> Bool false
|
||||
|
||||
let make_cek_continuation captured rest_kont =
|
||||
let data = Hashtbl.create 2 in
|
||||
Hashtbl.replace data "captured" captured;
|
||||
Hashtbl.replace data "rest-kont" rest_kont;
|
||||
Continuation ((fun v -> v), Some data)
|
||||
|
||||
let continuation_data v = match v with
|
||||
| Continuation (_, Some d) -> Dict d
|
||||
| Continuation (_, None) -> Dict (Hashtbl.create 0)
|
||||
| _ -> raise (Eval_error "not a continuation")
|
||||
|
||||
(* Dynamic wind — simplified for OCaml (no async) *)
|
||||
let dynamic_wind_call before body after _env =
|
||||
ignore (sx_call before []);
|
||||
let result = sx_call body [] in
|
||||
ignore (sx_call after []);
|
||||
result
|
||||
|
||||
(* Scope stack stubs — delegated to primitives when available *)
|
||||
let scope_push name value = prim_call "collect!" [name; value]
|
||||
let scope_pop _name = Nil
|
||||
let provide_push name value = ignore name; ignore value; Nil
|
||||
let provide_pop _name = Nil
|
||||
|
||||
(* Render mode stubs *)
|
||||
let render_active_p () = Bool false
|
||||
let render_expr _expr _env = Nil
|
||||
let is_render_expr _expr = Bool false
|
||||
|
||||
(* Signal accessors *)
|
||||
let signal_value s = match s with Signal sig' -> sig'.s_value | _ -> raise (Eval_error "not a signal")
|
||||
let signal_set_value s v = match s with Signal sig' -> sig'.s_value <- v; v | _ -> raise (Eval_error "not a signal")
|
||||
let signal_subscribers s = match s with Signal sig' -> List (List.map (fun _ -> Nil) sig'.s_subscribers) | _ -> List []
|
||||
let signal_add_sub_b _s _f = Nil
|
||||
let signal_remove_sub_b _s _f = Nil
|
||||
let signal_deps _s = List []
|
||||
let signal_set_deps _s _d = Nil
|
||||
let notify_subscribers _s = Nil
|
||||
let flush_subscribers _s = Nil
|
||||
let dispose_computed _s = Nil
|
||||
|
||||
(* Island scope stubs — accept OCaml functions from transpiled code *)
|
||||
let with_island_scope _register_fn body_fn = body_fn ()
|
||||
let register_in_scope _dispose_fn = Nil
|
||||
|
||||
(* Component type annotation stub *)
|
||||
let component_set_param_types_b _comp _types = Nil
|
||||
|
||||
(* Parse keyword args from a call — this is defined in evaluator.sx,
|
||||
the transpiled version will override this stub. *)
|
||||
(* Forward-reference stubs for evaluator functions used before definition *)
|
||||
let parse_comp_params _params = List [List []; Nil; Bool false]
|
||||
let parse_macro_params _params = List [List []; Nil]
|
||||
|
||||
let parse_keyword_args _raw_args _env =
|
||||
(* Stub — the real implementation is transpiled from evaluator.sx *)
|
||||
List [Dict (Hashtbl.create 0); List []]
|
||||
|
||||
(* Make handler/query/action/page def stubs *)
|
||||
let make_handler_def name params body _env = Dict (let d = Hashtbl.create 4 in Hashtbl.replace d "type" (String "handler"); Hashtbl.replace d "name" name; Hashtbl.replace d "params" params; Hashtbl.replace d "body" body; d)
|
||||
let make_query_def name params body _env = make_handler_def name params body _env
|
||||
let make_action_def name params body _env = make_handler_def name params body _env
|
||||
let make_page_def name _opts = Dict (let d = Hashtbl.create 4 in Hashtbl.replace d "type" (String "page"); Hashtbl.replace d "name" name; d)
|
||||
|
||||
(* sf-def* stubs — platform-specific def-forms, not in the SX spec *)
|
||||
let sf_defhandler args env =
|
||||
let name = first args in let rest_args = rest args in
|
||||
make_handler_def name (first rest_args) (nth rest_args (Number 1.0)) env
|
||||
let sf_defquery args env = sf_defhandler args env
|
||||
let sf_defaction args env = sf_defhandler args env
|
||||
let sf_defpage args _env =
|
||||
let name = first args in make_page_def name (rest args)
|
||||
|
||||
let strip_prefix s prefix =
|
||||
match s, prefix with
|
||||
| String s, String p ->
|
||||
let pl = String.length p in
|
||||
if String.length s >= pl && String.sub s 0 pl = p
|
||||
then String (String.sub s pl (String.length s - pl))
|
||||
else String s
|
||||
| _ -> s
|
||||
392
hosts/ocaml/lib/sx_types.ml
Normal file
392
hosts/ocaml/lib/sx_types.ml
Normal file
@@ -0,0 +1,392 @@
|
||||
(** Core types for the SX language.
|
||||
|
||||
The [value] sum type represents every possible SX runtime value.
|
||||
OCaml's algebraic types make the CEK machine's frame dispatch a
|
||||
pattern match — exactly what the spec describes. *)
|
||||
|
||||
(** {1 Environment} *)
|
||||
|
||||
(** Lexical scope chain. Each frame holds a mutable binding table and
|
||||
an optional parent link for scope-chain lookup. *)
|
||||
type env = {
|
||||
bindings : (string, value) Hashtbl.t;
|
||||
parent : env option;
|
||||
}
|
||||
|
||||
(** {1 Values} *)
|
||||
|
||||
and value =
|
||||
| Nil
|
||||
| Bool of bool
|
||||
| Number of float
|
||||
| String of string
|
||||
| Symbol of string
|
||||
| Keyword of string
|
||||
| List of value list
|
||||
| Dict of dict
|
||||
| Lambda of lambda
|
||||
| Component of component
|
||||
| Island of island
|
||||
| Macro of macro
|
||||
| Thunk of value * env
|
||||
| Continuation of (value -> value) * dict option
|
||||
| NativeFn of string * (value list -> value)
|
||||
| Signal of signal
|
||||
| RawHTML of string
|
||||
| Spread of (string * value) list
|
||||
| SxExpr of string (** Opaque SX wire-format string — aser output. *)
|
||||
| Env of env (** First-class environment — used by CEK machine state dicts. *)
|
||||
| ListRef of value list ref (** Mutable list — JS-style array for append! *)
|
||||
|
||||
(** Mutable string-keyed table (SX dicts support [dict-set!]). *)
|
||||
and dict = (string, value) Hashtbl.t
|
||||
|
||||
and lambda = {
|
||||
l_params : string list;
|
||||
l_body : value;
|
||||
l_closure : env;
|
||||
mutable l_name : string option;
|
||||
}
|
||||
|
||||
and component = {
|
||||
c_name : string;
|
||||
c_params : string list;
|
||||
c_has_children : bool;
|
||||
c_body : value;
|
||||
c_closure : env;
|
||||
c_affinity : string; (** "auto" | "client" | "server" *)
|
||||
}
|
||||
|
||||
and island = {
|
||||
i_name : string;
|
||||
i_params : string list;
|
||||
i_has_children : bool;
|
||||
i_body : value;
|
||||
i_closure : env;
|
||||
}
|
||||
|
||||
and macro = {
|
||||
m_params : string list;
|
||||
m_rest_param : string option;
|
||||
m_body : value;
|
||||
m_closure : env;
|
||||
m_name : string option;
|
||||
}
|
||||
|
||||
and signal = {
|
||||
mutable s_value : value;
|
||||
mutable s_subscribers : (unit -> unit) list;
|
||||
mutable s_deps : signal list;
|
||||
}
|
||||
|
||||
|
||||
(** {1 Errors} *)
|
||||
|
||||
exception Eval_error of string
|
||||
exception Parse_error of string
|
||||
|
||||
|
||||
(** {1 Environment operations} *)
|
||||
|
||||
let make_env () =
|
||||
{ bindings = Hashtbl.create 16; parent = None }
|
||||
|
||||
let env_extend parent =
|
||||
{ bindings = Hashtbl.create 16; parent = Some parent }
|
||||
|
||||
let env_bind env name v =
|
||||
Hashtbl.replace env.bindings name v; Nil
|
||||
|
||||
let rec env_has env name =
|
||||
Hashtbl.mem env.bindings name ||
|
||||
match env.parent with Some p -> env_has p name | None -> false
|
||||
|
||||
let rec env_get env name =
|
||||
match Hashtbl.find_opt env.bindings name with
|
||||
| Some v -> v
|
||||
| None ->
|
||||
match env.parent with
|
||||
| Some p -> env_get p name
|
||||
| None -> raise (Eval_error ("Undefined symbol: " ^ name))
|
||||
|
||||
let rec env_set env name v =
|
||||
if Hashtbl.mem env.bindings name then
|
||||
(Hashtbl.replace env.bindings name v; Nil)
|
||||
else
|
||||
match env.parent with
|
||||
| Some p -> env_set p name v
|
||||
| None -> Hashtbl.replace env.bindings name v; Nil
|
||||
|
||||
let env_merge base overlay =
|
||||
(* If base and overlay are the same env (physical equality) or overlay
|
||||
is a descendant of base, just extend base — no copying needed.
|
||||
This prevents set! inside lambdas from modifying shadow copies. *)
|
||||
if base == overlay then
|
||||
{ bindings = Hashtbl.create 16; parent = Some base }
|
||||
else begin
|
||||
(* Check if overlay is a descendant of base *)
|
||||
let rec is_descendant e depth =
|
||||
if depth > 100 then false
|
||||
else if e == base then true
|
||||
else match e.parent with Some p -> is_descendant p (depth + 1) | None -> false
|
||||
in
|
||||
if is_descendant overlay 0 then
|
||||
{ bindings = Hashtbl.create 16; parent = Some base }
|
||||
else begin
|
||||
(* General case: extend base, copy ONLY overlay bindings that don't
|
||||
exist anywhere in the base chain (avoids shadowing closure bindings). *)
|
||||
let e = { bindings = Hashtbl.create 16; parent = Some base } in
|
||||
Hashtbl.iter (fun k v ->
|
||||
if not (env_has base k) then Hashtbl.replace e.bindings k v
|
||||
) overlay.bindings;
|
||||
e
|
||||
end
|
||||
end
|
||||
|
||||
|
||||
(** {1 Value extraction helpers} *)
|
||||
|
||||
let value_to_string = function
|
||||
| String s -> s | Symbol s -> s | Keyword k -> k
|
||||
| Number n -> if Float.is_integer n then string_of_int (int_of_float n) else Printf.sprintf "%g" n
|
||||
| Bool true -> "true" | Bool false -> "false"
|
||||
| Nil -> "" | _ -> "<value>"
|
||||
|
||||
let value_to_string_list = function
|
||||
| List items | ListRef { contents = items } -> List.map value_to_string items
|
||||
| _ -> []
|
||||
|
||||
let value_to_bool = function
|
||||
| Bool b -> b | Nil -> false | _ -> true
|
||||
|
||||
let value_to_string_opt = function
|
||||
| String s -> Some s | Symbol s -> Some s | Nil -> None | _ -> None
|
||||
|
||||
|
||||
(** {1 Constructors — accept [value] args from transpiled code} *)
|
||||
|
||||
let unwrap_env_val = function
|
||||
| Env e -> e
|
||||
| _ -> raise (Eval_error "make_lambda: expected env for closure")
|
||||
|
||||
let make_lambda params body closure =
|
||||
let ps = match params with
|
||||
| List items -> List.map value_to_string items
|
||||
| _ -> value_to_string_list params
|
||||
in
|
||||
Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None }
|
||||
|
||||
let make_component name params has_children body closure affinity =
|
||||
let n = value_to_string name in
|
||||
let ps = value_to_string_list params in
|
||||
let hc = value_to_bool has_children in
|
||||
let aff = match affinity with String s -> s | _ -> "auto" in
|
||||
Component {
|
||||
c_name = n; c_params = ps; c_has_children = hc;
|
||||
c_body = body; c_closure = unwrap_env_val closure; c_affinity = aff;
|
||||
}
|
||||
|
||||
let make_island name params has_children body closure =
|
||||
let n = value_to_string name in
|
||||
let ps = value_to_string_list params in
|
||||
let hc = value_to_bool has_children in
|
||||
Island {
|
||||
i_name = n; i_params = ps; i_has_children = hc;
|
||||
i_body = body; i_closure = unwrap_env_val closure;
|
||||
}
|
||||
|
||||
let make_macro params rest_param body closure name =
|
||||
let ps = value_to_string_list params in
|
||||
let rp = value_to_string_opt rest_param in
|
||||
let n = value_to_string_opt name in
|
||||
Macro {
|
||||
m_params = ps; m_rest_param = rp;
|
||||
m_body = body; m_closure = unwrap_env_val closure; m_name = n;
|
||||
}
|
||||
|
||||
let make_thunk expr env = Thunk (expr, unwrap_env_val env)
|
||||
|
||||
let make_symbol name = Symbol (value_to_string name)
|
||||
let make_keyword name = Keyword (value_to_string name)
|
||||
|
||||
|
||||
(** {1 Type inspection} *)
|
||||
|
||||
let type_of = function
|
||||
| Nil -> "nil"
|
||||
| Bool _ -> "boolean"
|
||||
| Number _ -> "number"
|
||||
| String _ -> "string"
|
||||
| Symbol _ -> "symbol"
|
||||
| Keyword _ -> "keyword"
|
||||
| List _ | ListRef _ -> "list"
|
||||
| Dict _ -> "dict"
|
||||
| Lambda _ -> "lambda"
|
||||
| Component _ -> "component"
|
||||
| Island _ -> "island"
|
||||
| Macro _ -> "macro"
|
||||
| Thunk _ -> "thunk"
|
||||
| Continuation (_, _) -> "continuation"
|
||||
| NativeFn _ -> "function"
|
||||
| Signal _ -> "signal"
|
||||
| RawHTML _ -> "raw-html"
|
||||
| Spread _ -> "spread"
|
||||
| SxExpr _ -> "sx-expr"
|
||||
| Env _ -> "env"
|
||||
|
||||
let is_nil = function Nil -> true | _ -> false
|
||||
let is_lambda = function Lambda _ -> true | _ -> false
|
||||
let is_component = function Component _ -> true | _ -> false
|
||||
let is_island = function Island _ -> true | _ -> false
|
||||
let is_macro = function Macro _ -> true | _ -> false
|
||||
let is_thunk = function Thunk _ -> true | _ -> false
|
||||
let is_signal = function Signal _ -> true | _ -> false
|
||||
|
||||
let is_callable = function
|
||||
| Lambda _ | NativeFn _ | Continuation (_, _) -> true
|
||||
| _ -> false
|
||||
|
||||
|
||||
(** {1 Truthiness} *)
|
||||
|
||||
(** SX truthiness: everything is truthy except [Nil] and [Bool false]. *)
|
||||
let sx_truthy = function
|
||||
| Nil | Bool false -> false
|
||||
| _ -> true
|
||||
|
||||
|
||||
(** {1 Accessors} *)
|
||||
|
||||
let symbol_name = function
|
||||
| Symbol s -> String s
|
||||
| v -> raise (Eval_error ("Expected symbol, got " ^ type_of v))
|
||||
|
||||
let keyword_name = function
|
||||
| Keyword k -> String k
|
||||
| v -> raise (Eval_error ("Expected keyword, got " ^ type_of v))
|
||||
|
||||
let lambda_params = function
|
||||
| Lambda l -> List (List.map (fun s -> String s) l.l_params)
|
||||
| v -> raise (Eval_error ("Expected lambda, got " ^ type_of v))
|
||||
|
||||
let lambda_body = function
|
||||
| Lambda l -> l.l_body
|
||||
| v -> raise (Eval_error ("Expected lambda, got " ^ type_of v))
|
||||
|
||||
let lambda_closure = function
|
||||
| Lambda l -> Env l.l_closure
|
||||
| v -> raise (Eval_error ("Expected lambda, got " ^ type_of v))
|
||||
|
||||
let lambda_name = function
|
||||
| Lambda l -> (match l.l_name with Some n -> String n | None -> Nil)
|
||||
| v -> raise (Eval_error ("Expected lambda, got " ^ type_of v))
|
||||
|
||||
let set_lambda_name l n = match l with
|
||||
| Lambda l -> l.l_name <- Some n; Nil
|
||||
| _ -> raise (Eval_error "set-lambda-name!: not a lambda")
|
||||
|
||||
let component_name = function
|
||||
| Component c -> String c.c_name
|
||||
| v -> raise (Eval_error ("Expected component, got " ^ type_of v))
|
||||
|
||||
let component_params = function
|
||||
| Component c -> List (List.map (fun s -> String s) c.c_params)
|
||||
| v -> raise (Eval_error ("Expected component, got " ^ type_of v))
|
||||
|
||||
let component_body = function
|
||||
| Component c -> c.c_body
|
||||
| v -> raise (Eval_error ("Expected component, got " ^ type_of v))
|
||||
|
||||
let component_closure = function
|
||||
| Component c -> Env c.c_closure
|
||||
| v -> raise (Eval_error ("Expected component, got " ^ type_of v))
|
||||
|
||||
let component_has_children = function
|
||||
| Component c -> Bool c.c_has_children
|
||||
| v -> raise (Eval_error ("Expected component, got " ^ type_of v))
|
||||
|
||||
let component_affinity = function
|
||||
| Component c -> String c.c_affinity
|
||||
| _ -> String "auto"
|
||||
|
||||
let macro_params = function
|
||||
| Macro m -> List (List.map (fun s -> String s) m.m_params)
|
||||
| v -> raise (Eval_error ("Expected macro, got " ^ type_of v))
|
||||
|
||||
let macro_rest_param = function
|
||||
| Macro m -> (match m.m_rest_param with Some s -> String s | None -> Nil)
|
||||
| v -> raise (Eval_error ("Expected macro, got " ^ type_of v))
|
||||
|
||||
let macro_body = function
|
||||
| Macro m -> m.m_body
|
||||
| v -> raise (Eval_error ("Expected macro, got " ^ type_of v))
|
||||
|
||||
let macro_closure = function
|
||||
| Macro m -> Env m.m_closure
|
||||
| v -> raise (Eval_error ("Expected macro, got " ^ type_of v))
|
||||
|
||||
let thunk_expr = function
|
||||
| Thunk (e, _) -> e
|
||||
| v -> raise (Eval_error ("Expected thunk, got " ^ type_of v))
|
||||
|
||||
let thunk_env = function
|
||||
| Thunk (_, e) -> Env e
|
||||
| v -> raise (Eval_error ("Expected thunk, got " ^ type_of v))
|
||||
|
||||
|
||||
(** {1 Dict operations} *)
|
||||
|
||||
let make_dict () : dict = Hashtbl.create 8
|
||||
|
||||
let dict_get (d : dict) key =
|
||||
match Hashtbl.find_opt d key with Some v -> v | None -> Nil
|
||||
|
||||
let dict_has (d : dict) key = Hashtbl.mem d key
|
||||
|
||||
let dict_set (d : dict) key v = Hashtbl.replace d key v
|
||||
|
||||
let dict_delete (d : dict) key = Hashtbl.remove d key
|
||||
|
||||
let dict_keys (d : dict) =
|
||||
Hashtbl.fold (fun k _ acc -> String k :: acc) d []
|
||||
|
||||
let dict_vals (d : dict) =
|
||||
Hashtbl.fold (fun _ v acc -> v :: acc) d []
|
||||
|
||||
|
||||
(** {1 Value display} *)
|
||||
|
||||
let rec inspect = function
|
||||
| Nil -> "nil"
|
||||
| Bool true -> "true"
|
||||
| Bool false -> "false"
|
||||
| Number n ->
|
||||
if Float.is_integer n then Printf.sprintf "%d" (int_of_float n)
|
||||
else Printf.sprintf "%g" n
|
||||
| String s -> Printf.sprintf "%S" s
|
||||
| Symbol s -> s
|
||||
| Keyword k -> ":" ^ k
|
||||
| List items | ListRef { contents = items } ->
|
||||
"(" ^ String.concat " " (List.map inspect items) ^ ")"
|
||||
| Dict d ->
|
||||
let pairs = Hashtbl.fold (fun k v acc ->
|
||||
(Printf.sprintf ":%s %s" k (inspect v)) :: acc) d [] in
|
||||
"{" ^ String.concat " " pairs ^ "}"
|
||||
| Lambda l ->
|
||||
let tag = match l.l_name with Some n -> n | None -> "lambda" in
|
||||
Printf.sprintf "<%s(%s)>" tag (String.concat ", " l.l_params)
|
||||
| Component c ->
|
||||
Printf.sprintf "<Component ~%s(%s)>" c.c_name (String.concat ", " c.c_params)
|
||||
| Island i ->
|
||||
Printf.sprintf "<Island ~%s(%s)>" i.i_name (String.concat ", " i.i_params)
|
||||
| Macro m ->
|
||||
let tag = match m.m_name with Some n -> n | None -> "macro" in
|
||||
Printf.sprintf "<%s(%s)>" tag (String.concat ", " m.m_params)
|
||||
| Thunk _ -> "<thunk>"
|
||||
| Continuation (_, _) -> "<continuation>"
|
||||
| NativeFn (name, _) -> Printf.sprintf "<native:%s>" name
|
||||
| Signal _ -> "<signal>"
|
||||
| RawHTML s -> Printf.sprintf "<raw-html:%d chars>" (String.length s)
|
||||
| Spread _ -> "<spread>"
|
||||
| SxExpr s -> Printf.sprintf "<sx-expr:%d chars>" (String.length s)
|
||||
| Env _ -> "<env>"
|
||||
1230
hosts/ocaml/transpiler.sx
Normal file
1230
hosts/ocaml/transpiler.sx
Normal file
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -20,17 +20,21 @@ logger = logging.getLogger("sx.boundary_parser")
|
||||
|
||||
# Allow standalone use (from bootstrappers) or in-project imports
|
||||
try:
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.types import Symbol, Keyword, NIL as SX_NIL
|
||||
except ImportError:
|
||||
import sys
|
||||
_HERE = os.path.dirname(os.path.abspath(__file__))
|
||||
_PROJECT = os.path.abspath(os.path.join(_HERE, "..", "..", ".."))
|
||||
sys.path.insert(0, _PROJECT)
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.types import Symbol, Keyword, NIL as SX_NIL
|
||||
|
||||
|
||||
def _get_parse_all():
|
||||
"""Lazy import to avoid circular dependency when parser.py loads sx_ref.py."""
|
||||
from shared.sx.parser import parse_all
|
||||
return parse_all
|
||||
|
||||
|
||||
def _ref_dir() -> str:
|
||||
return os.path.dirname(os.path.abspath(__file__))
|
||||
|
||||
@@ -81,7 +85,7 @@ def _extract_declarations(
|
||||
|
||||
Returns (io_names, {service: helper_names}).
|
||||
"""
|
||||
exprs = parse_all(source)
|
||||
exprs = _get_parse_all()(source)
|
||||
io_names: set[str] = set()
|
||||
helpers: dict[str, set[str]] = {}
|
||||
|
||||
@@ -144,7 +148,7 @@ def parse_primitives_sx() -> frozenset[str]:
|
||||
def parse_primitives_by_module() -> dict[str, frozenset[str]]:
|
||||
"""Parse primitives.sx and return primitives grouped by module."""
|
||||
source = _read_file("primitives.sx")
|
||||
exprs = parse_all(source)
|
||||
exprs = _get_parse_all()(source)
|
||||
modules: dict[str, set[str]] = {}
|
||||
current_module = "_unscoped"
|
||||
|
||||
@@ -169,6 +173,83 @@ def parse_primitives_by_module() -> dict[str, frozenset[str]]:
|
||||
return {mod: frozenset(names) for mod, names in modules.items()}
|
||||
|
||||
|
||||
def _parse_param_type(param) -> tuple[str, str | None, bool]:
|
||||
"""Parse a single param entry from a :params list.
|
||||
|
||||
Returns (name, type_or_none, is_rest).
|
||||
A bare symbol like ``x`` → ("x", None, False).
|
||||
A typed form ``(x :as number)`` → ("x", "number", False).
|
||||
The ``&rest`` marker is tracked externally.
|
||||
"""
|
||||
if isinstance(param, Symbol):
|
||||
return (param.name, None, False)
|
||||
if isinstance(param, list) and len(param) == 3:
|
||||
# (name :as type)
|
||||
name_sym, kw, type_val = param
|
||||
if (isinstance(name_sym, Symbol)
|
||||
and isinstance(kw, Keyword) and kw.name == "as"):
|
||||
type_str = type_val.name if isinstance(type_val, Symbol) else str(type_val)
|
||||
return (name_sym.name, type_str, False)
|
||||
return (str(param), None, False)
|
||||
|
||||
|
||||
def parse_primitive_param_types() -> dict[str, dict]:
|
||||
"""Parse primitives.sx and extract param type info for each primitive.
|
||||
|
||||
Returns a dict mapping primitive name to param type descriptor::
|
||||
|
||||
{
|
||||
"+": {"positional": [], "rest_type": "number"},
|
||||
"/": {"positional": [("a", "number"), ("b", "number")], "rest_type": None},
|
||||
"get": {"positional": [("coll", None), ("key", None)], "rest_type": None},
|
||||
}
|
||||
|
||||
Each positional entry is (name, type_or_none). rest_type is the
|
||||
type of the &rest parameter (or None if no &rest, or None if untyped &rest).
|
||||
"""
|
||||
source = _read_file("primitives.sx")
|
||||
exprs = _get_parse_all()(source)
|
||||
result: dict[str, dict] = {}
|
||||
|
||||
for expr in exprs:
|
||||
if not isinstance(expr, list) or len(expr) < 2:
|
||||
continue
|
||||
if not isinstance(expr[0], Symbol) or expr[0].name != "define-primitive":
|
||||
continue
|
||||
|
||||
name = expr[1]
|
||||
if not isinstance(name, str):
|
||||
continue
|
||||
|
||||
params_list = _extract_keyword_arg(expr, "params")
|
||||
if not isinstance(params_list, list):
|
||||
continue
|
||||
|
||||
positional: list[tuple[str, str | None]] = []
|
||||
rest_type: str | None = None
|
||||
i = 0
|
||||
while i < len(params_list):
|
||||
item = params_list[i]
|
||||
if isinstance(item, Symbol) and item.name == "&rest":
|
||||
# Next item is the rest param
|
||||
if i + 1 < len(params_list):
|
||||
rname, rtype, _ = _parse_param_type(params_list[i + 1])
|
||||
rest_type = rtype
|
||||
i += 2
|
||||
else:
|
||||
pname, ptype, _ = _parse_param_type(item)
|
||||
if pname != "&rest":
|
||||
positional.append((pname, ptype))
|
||||
i += 1
|
||||
|
||||
# Only store if at least one param has a type
|
||||
has_types = rest_type is not None or any(t is not None for _, t in positional)
|
||||
if has_types:
|
||||
result[name] = {"positional": positional, "rest_type": rest_type}
|
||||
|
||||
return result
|
||||
|
||||
|
||||
def parse_boundary_sx() -> tuple[frozenset[str], dict[str, frozenset[str]]]:
|
||||
"""Parse all boundary sources and return (io_names, {service: helper_names}).
|
||||
|
||||
@@ -206,10 +287,62 @@ def parse_boundary_sx() -> tuple[frozenset[str], dict[str, frozenset[str]]]:
|
||||
return frozenset(all_io), frozen_helpers
|
||||
|
||||
|
||||
def parse_boundary_effects() -> dict[str, list[str]]:
|
||||
"""Parse boundary.sx and return effect annotations for all declared primitives.
|
||||
|
||||
Returns a dict mapping primitive name to its declared effects list.
|
||||
E.g. {"current-user": ["io"], "reset!": ["mutation"], "signal": []}.
|
||||
|
||||
Only includes primitives that have an explicit :effects declaration.
|
||||
Pure primitives from primitives.sx are not included (they have no effects).
|
||||
"""
|
||||
source = _read_file("boundary.sx")
|
||||
exprs = _get_parse_all()(source)
|
||||
result: dict[str, list[str]] = {}
|
||||
|
||||
_DECL_FORMS = {
|
||||
"define-io-primitive", "declare-signal-primitive",
|
||||
"declare-spread-primitive",
|
||||
}
|
||||
|
||||
for expr in exprs:
|
||||
if not isinstance(expr, list) or len(expr) < 2:
|
||||
continue
|
||||
head = expr[0]
|
||||
if not isinstance(head, Symbol) or head.name not in _DECL_FORMS:
|
||||
continue
|
||||
|
||||
name = expr[1]
|
||||
if not isinstance(name, str):
|
||||
continue
|
||||
|
||||
effects_val = _extract_keyword_arg(expr, "effects")
|
||||
if effects_val is None:
|
||||
# IO primitives default to [io] if no explicit :effects
|
||||
if head.name == "define-io-primitive":
|
||||
result[name] = ["io"]
|
||||
continue
|
||||
|
||||
if isinstance(effects_val, list):
|
||||
effect_names = []
|
||||
for item in effects_val:
|
||||
if isinstance(item, Symbol):
|
||||
effect_names.append(item.name)
|
||||
elif isinstance(item, str):
|
||||
effect_names.append(item)
|
||||
result[name] = effect_names
|
||||
else:
|
||||
# Might be a single symbol
|
||||
if isinstance(effects_val, Symbol):
|
||||
result[name] = [effects_val.name]
|
||||
|
||||
return result
|
||||
|
||||
|
||||
def parse_boundary_types() -> frozenset[str]:
|
||||
"""Parse boundary.sx and return the declared boundary type names."""
|
||||
source = _read_file("boundary.sx")
|
||||
exprs = parse_all(source)
|
||||
exprs = _get_parse_all()(source)
|
||||
for expr in exprs:
|
||||
if (isinstance(expr, list) and len(expr) >= 2
|
||||
and isinstance(expr[0], Symbol)
|
||||
1662
hosts/python/platform.py
Normal file
1662
hosts/python/platform.py
Normal file
File diff suppressed because it is too large
Load Diff
251
hosts/python/tests/run_cek_reactive_tests.py
Normal file
251
hosts/python/tests/run_cek_reactive_tests.py
Normal file
@@ -0,0 +1,251 @@
|
||||
#!/usr/bin/env python3
|
||||
"""Run test-cek-reactive.sx — tests for deref-as-shift reactive rendering."""
|
||||
from __future__ import annotations
|
||||
import os, sys
|
||||
|
||||
_HERE = os.path.dirname(os.path.abspath(__file__))
|
||||
_PROJECT = os.path.abspath(os.path.join(_HERE, "..", "..", ".."))
|
||||
_SPEC_TESTS = os.path.join(_PROJECT, "spec", "tests")
|
||||
_WEB_TESTS = os.path.join(_PROJECT, "web", "tests")
|
||||
sys.path.insert(0, _PROJECT)
|
||||
sys.setrecursionlimit(20000)
|
||||
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.ref import sx_ref
|
||||
from shared.sx.ref.sx_ref import (
|
||||
make_env, env_get, env_has, env_set,
|
||||
env_extend, env_merge,
|
||||
)
|
||||
# Use tree-walk evaluator for interpreting .sx test files.
|
||||
# The CEK override (eval_expr = cek_run) would cause the interpreted cek.sx
|
||||
# to delegate to the transpiled CEK, not the interpreted one being tested.
|
||||
# Override both the local names AND the module-level names so that transpiled
|
||||
# functions (ho_map, call_lambda, etc.) also use tree-walk internally.
|
||||
eval_expr = sx_ref._tree_walk_eval_expr
|
||||
trampoline = sx_ref._tree_walk_trampoline
|
||||
sx_ref.eval_expr = eval_expr
|
||||
sx_ref.trampoline = trampoline
|
||||
from shared.sx.types import (
|
||||
NIL, Symbol, Keyword, Lambda, Component, Island, Continuation, Macro,
|
||||
_ShiftSignal,
|
||||
)
|
||||
|
||||
# Build env with primitives
|
||||
env = make_env()
|
||||
|
||||
# Platform test functions
|
||||
_suite_stack: list[str] = []
|
||||
_pass_count = 0
|
||||
_fail_count = 0
|
||||
|
||||
def _try_call(thunk):
|
||||
try:
|
||||
trampoline(eval_expr([thunk], env))
|
||||
return {"ok": True}
|
||||
except Exception as e:
|
||||
return {"ok": False, "error": str(e)}
|
||||
|
||||
def _report_pass(name):
|
||||
global _pass_count
|
||||
_pass_count += 1
|
||||
ctx = " > ".join(_suite_stack)
|
||||
print(f" PASS: {ctx} > {name}")
|
||||
return NIL
|
||||
|
||||
def _report_fail(name, error):
|
||||
global _fail_count
|
||||
_fail_count += 1
|
||||
ctx = " > ".join(_suite_stack)
|
||||
print(f" FAIL: {ctx} > {name}: {error}")
|
||||
return NIL
|
||||
|
||||
def _push_suite(name):
|
||||
_suite_stack.append(name)
|
||||
print(f"{' ' * (len(_suite_stack)-1)}Suite: {name}")
|
||||
return NIL
|
||||
|
||||
def _pop_suite():
|
||||
if _suite_stack:
|
||||
_suite_stack.pop()
|
||||
return NIL
|
||||
|
||||
def _test_env():
|
||||
return env
|
||||
|
||||
def _sx_parse(source):
|
||||
return parse_all(source)
|
||||
|
||||
def _sx_parse_one(source):
|
||||
"""Parse a single expression."""
|
||||
exprs = parse_all(source)
|
||||
return exprs[0] if exprs else NIL
|
||||
|
||||
def _make_continuation(fn):
|
||||
return Continuation(fn)
|
||||
|
||||
env["try-call"] = _try_call
|
||||
env["report-pass"] = _report_pass
|
||||
env["report-fail"] = _report_fail
|
||||
env["push-suite"] = _push_suite
|
||||
env["pop-suite"] = _pop_suite
|
||||
env["test-env"] = _test_env
|
||||
env["sx-parse"] = _sx_parse
|
||||
env["sx-parse-one"] = _sx_parse_one
|
||||
env["env-get"] = env_get
|
||||
env["env-has?"] = env_has
|
||||
env["env-set!"] = env_set
|
||||
env["env-extend"] = env_extend
|
||||
env["make-continuation"] = _make_continuation
|
||||
env["continuation?"] = lambda x: isinstance(x, Continuation)
|
||||
env["continuation-fn"] = lambda c: c.fn
|
||||
|
||||
def _make_cek_continuation_with_data(captured, rest_kont):
|
||||
c = Continuation(lambda v=NIL: v)
|
||||
c._cek_data = {"captured": captured, "rest-kont": rest_kont}
|
||||
return c
|
||||
|
||||
env["make-cek-continuation"] = _make_cek_continuation_with_data
|
||||
env["continuation-data"] = lambda c: getattr(c, '_cek_data', {})
|
||||
|
||||
# Type predicates and constructors
|
||||
env["callable?"] = lambda x: callable(x) or isinstance(x, (Lambda, Component, Island, Continuation))
|
||||
env["lambda?"] = lambda x: isinstance(x, Lambda)
|
||||
env["component?"] = lambda x: isinstance(x, Component)
|
||||
env["island?"] = lambda x: isinstance(x, Island)
|
||||
env["macro?"] = lambda x: isinstance(x, Macro)
|
||||
env["thunk?"] = sx_ref.is_thunk
|
||||
env["thunk-expr"] = sx_ref.thunk_expr
|
||||
env["thunk-env"] = sx_ref.thunk_env
|
||||
env["make-thunk"] = sx_ref.make_thunk
|
||||
env["make-lambda"] = sx_ref.make_lambda
|
||||
env["make-component"] = sx_ref.make_component
|
||||
env["make-island"] = sx_ref.make_island
|
||||
env["make-macro"] = sx_ref.make_macro
|
||||
env["make-symbol"] = lambda n: Symbol(n)
|
||||
env["lambda-params"] = lambda f: f.params
|
||||
env["lambda-body"] = lambda f: f.body
|
||||
env["lambda-closure"] = lambda f: f.closure
|
||||
env["lambda-name"] = lambda f: f.name
|
||||
env["set-lambda-name!"] = lambda f, n: setattr(f, 'name', n) or NIL
|
||||
env["component-params"] = lambda c: c.params
|
||||
env["component-body"] = lambda c: c.body
|
||||
env["component-closure"] = lambda c: c.closure
|
||||
env["component-has-children?"] = lambda c: c.has_children
|
||||
env["component-affinity"] = lambda c: getattr(c, 'affinity', 'auto')
|
||||
env["component-set-param-types!"] = lambda c, t: setattr(c, 'param_types', t) or NIL
|
||||
env["macro-params"] = lambda m: m.params
|
||||
env["macro-rest-param"] = lambda m: m.rest_param
|
||||
env["macro-body"] = lambda m: m.body
|
||||
env["macro-closure"] = lambda m: m.closure
|
||||
env["env-merge"] = env_merge
|
||||
env["symbol-name"] = lambda s: s.name if isinstance(s, Symbol) else str(s)
|
||||
env["keyword-name"] = lambda k: k.name if isinstance(k, Keyword) else str(k)
|
||||
env["type-of"] = sx_ref.type_of
|
||||
env["primitive?"] = sx_ref.is_primitive
|
||||
env["get-primitive"] = sx_ref.get_primitive
|
||||
env["strip-prefix"] = lambda s, p: s[len(p):] if s.startswith(p) else s
|
||||
env["inspect"] = repr
|
||||
env["debug-log"] = lambda *args: None
|
||||
env["error"] = sx_ref.error
|
||||
env["apply"] = lambda f, args: f(*args)
|
||||
|
||||
# Functions from eval.sx that cek.sx references
|
||||
env["trampoline"] = trampoline
|
||||
env["eval-expr"] = eval_expr
|
||||
env["eval-list"] = sx_ref.eval_list
|
||||
env["eval-call"] = sx_ref.eval_call
|
||||
env["call-lambda"] = sx_ref.call_lambda
|
||||
env["call-component"] = sx_ref.call_component
|
||||
env["parse-keyword-args"] = sx_ref.parse_keyword_args
|
||||
env["sf-lambda"] = sx_ref.sf_lambda
|
||||
env["sf-defcomp"] = sx_ref.sf_defcomp
|
||||
env["sf-defisland"] = sx_ref.sf_defisland
|
||||
env["sf-defmacro"] = sx_ref.sf_defmacro
|
||||
env["sf-defstyle"] = sx_ref.sf_defstyle
|
||||
env["sf-deftype"] = sx_ref.sf_deftype
|
||||
env["sf-defeffect"] = sx_ref.sf_defeffect
|
||||
env["sf-letrec"] = sx_ref.sf_letrec
|
||||
env["sf-named-let"] = sx_ref.sf_named_let
|
||||
env["sf-dynamic-wind"] = sx_ref.sf_dynamic_wind
|
||||
env["sf-scope"] = sx_ref.sf_scope
|
||||
env["sf-provide"] = sx_ref.sf_provide
|
||||
env["qq-expand"] = sx_ref.qq_expand
|
||||
env["expand-macro"] = sx_ref.expand_macro
|
||||
env["cond-scheme?"] = sx_ref.cond_scheme_p
|
||||
|
||||
# Higher-order form handlers
|
||||
env["ho-map"] = sx_ref.ho_map
|
||||
env["ho-map-indexed"] = sx_ref.ho_map_indexed
|
||||
env["ho-filter"] = sx_ref.ho_filter
|
||||
env["ho-reduce"] = sx_ref.ho_reduce
|
||||
env["ho-some"] = sx_ref.ho_some
|
||||
env["ho-every"] = sx_ref.ho_every
|
||||
env["ho-for-each"] = sx_ref.ho_for_each
|
||||
env["call-fn"] = sx_ref.call_fn
|
||||
|
||||
# Render-related (stub for testing — no active rendering)
|
||||
env["render-active?"] = lambda: False
|
||||
env["is-render-expr?"] = lambda expr: False
|
||||
env["render-expr"] = lambda expr, env: NIL
|
||||
|
||||
# Scope primitives (needed for reactive-shift-deref island cleanup)
|
||||
env["scope-push!"] = sx_ref.PRIMITIVES.get("scope-push!", lambda *a: NIL)
|
||||
env["scope-pop!"] = sx_ref.PRIMITIVES.get("scope-pop!", lambda *a: NIL)
|
||||
env["context"] = sx_ref.PRIMITIVES.get("context", lambda *a: NIL)
|
||||
env["emit!"] = sx_ref.PRIMITIVES.get("emit!", lambda *a: NIL)
|
||||
env["emitted"] = sx_ref.PRIMITIVES.get("emitted", lambda *a: [])
|
||||
|
||||
# Dynamic wind
|
||||
env["push-wind!"] = lambda before, after: NIL
|
||||
env["pop-wind!"] = lambda: NIL
|
||||
env["call-thunk"] = lambda f, e: f() if callable(f) else trampoline(eval_expr([f], e))
|
||||
|
||||
# Mutation helpers
|
||||
env["dict-get"] = lambda d, k: d.get(k, NIL) if isinstance(d, dict) else NIL
|
||||
env["identical?"] = lambda a, b: a is b
|
||||
|
||||
# defhandler, defpage, defquery, defaction stubs
|
||||
for name in ["sf-defhandler", "sf-defpage", "sf-defquery", "sf-defaction"]:
|
||||
pyname = name.replace("-", "_")
|
||||
fn = getattr(sx_ref, pyname, None)
|
||||
if fn:
|
||||
env[name] = fn
|
||||
else:
|
||||
env[name] = lambda args, e, _n=name: NIL
|
||||
|
||||
# Load test framework
|
||||
with open(os.path.join(_SPEC_TESTS, "test-framework.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Load signals module
|
||||
print("Loading signals.sx ...")
|
||||
with open(os.path.join(_PROJECT, "web", "signals.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Load frames module
|
||||
print("Loading frames.sx ...")
|
||||
with open(os.path.join(_PROJECT, "spec", "frames.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Load CEK module
|
||||
print("Loading cek.sx ...")
|
||||
with open(os.path.join(_PROJECT, "spec", "cek.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Run tests
|
||||
print("=" * 60)
|
||||
print("Running test-cek-reactive.sx")
|
||||
print("=" * 60)
|
||||
|
||||
with open(os.path.join(_WEB_TESTS, "test-cek-reactive.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
print("=" * 60)
|
||||
print(f"Results: {_pass_count} passed, {_fail_count} failed")
|
||||
print("=" * 60)
|
||||
sys.exit(1 if _fail_count > 0 else 0)
|
||||
267
hosts/python/tests/run_cek_tests.py
Normal file
267
hosts/python/tests/run_cek_tests.py
Normal file
@@ -0,0 +1,267 @@
|
||||
#!/usr/bin/env python3
|
||||
"""Run test-cek.sx using the bootstrapped evaluator with CEK module loaded."""
|
||||
from __future__ import annotations
|
||||
import os, sys
|
||||
|
||||
_HERE = os.path.dirname(os.path.abspath(__file__))
|
||||
_PROJECT = os.path.abspath(os.path.join(_HERE, "..", "..", ".."))
|
||||
_SPEC_TESTS = os.path.join(_PROJECT, "spec", "tests")
|
||||
_WEB_TESTS = os.path.join(_PROJECT, "web", "tests")
|
||||
sys.path.insert(0, _PROJECT)
|
||||
|
||||
from shared.sx.ref.sx_ref import sx_parse as parse_all
|
||||
from shared.sx.ref import sx_ref
|
||||
from shared.sx.ref.sx_ref import (
|
||||
make_env, env_get, env_has, env_set,
|
||||
env_extend, env_merge,
|
||||
)
|
||||
# Use tree-walk evaluator for interpreting .sx test files.
|
||||
# The CEK override (eval_expr = cek_run) would cause the interpreted cek.sx
|
||||
# to delegate to the transpiled CEK, not the interpreted one being tested.
|
||||
# Override both the local names AND the module-level names so that transpiled
|
||||
# functions (ho_map, call_lambda, etc.) also use tree-walk internally.
|
||||
eval_expr = sx_ref._tree_walk_eval_expr
|
||||
trampoline = sx_ref._tree_walk_trampoline
|
||||
sx_ref.eval_expr = eval_expr
|
||||
sx_ref.trampoline = trampoline
|
||||
from shared.sx.types import (
|
||||
NIL, Symbol, Keyword, Lambda, Component, Island, Continuation, Macro,
|
||||
_ShiftSignal,
|
||||
)
|
||||
|
||||
# Build env with primitives
|
||||
env = make_env()
|
||||
|
||||
# Platform test functions
|
||||
_suite_stack: list[str] = []
|
||||
_pass_count = 0
|
||||
_fail_count = 0
|
||||
|
||||
def _try_call(thunk):
|
||||
try:
|
||||
trampoline(eval_expr([thunk], env))
|
||||
return {"ok": True}
|
||||
except Exception as e:
|
||||
return {"ok": False, "error": str(e)}
|
||||
|
||||
def _report_pass(name):
|
||||
global _pass_count
|
||||
_pass_count += 1
|
||||
ctx = " > ".join(_suite_stack)
|
||||
print(f" PASS: {ctx} > {name}")
|
||||
return NIL
|
||||
|
||||
def _report_fail(name, error):
|
||||
global _fail_count
|
||||
_fail_count += 1
|
||||
ctx = " > ".join(_suite_stack)
|
||||
print(f" FAIL: {ctx} > {name}: {error}")
|
||||
return NIL
|
||||
|
||||
def _push_suite(name):
|
||||
_suite_stack.append(name)
|
||||
print(f"{' ' * (len(_suite_stack)-1)}Suite: {name}")
|
||||
return NIL
|
||||
|
||||
def _pop_suite():
|
||||
if _suite_stack:
|
||||
_suite_stack.pop()
|
||||
return NIL
|
||||
|
||||
def _test_env():
|
||||
return env
|
||||
|
||||
def _sx_parse(source):
|
||||
return parse_all(source)
|
||||
|
||||
def _sx_parse_one(source):
|
||||
"""Parse a single expression."""
|
||||
exprs = parse_all(source)
|
||||
return exprs[0] if exprs else NIL
|
||||
|
||||
def _make_continuation(fn):
|
||||
return Continuation(fn)
|
||||
|
||||
env["try-call"] = _try_call
|
||||
env["report-pass"] = _report_pass
|
||||
env["report-fail"] = _report_fail
|
||||
env["push-suite"] = _push_suite
|
||||
env["pop-suite"] = _pop_suite
|
||||
env["test-env"] = _test_env
|
||||
env["sx-parse"] = _sx_parse
|
||||
env["sx-parse-one"] = _sx_parse_one
|
||||
env["env-get"] = env_get
|
||||
env["env-has?"] = env_has
|
||||
env["env-set!"] = env_set
|
||||
env["env-extend"] = env_extend
|
||||
env["make-continuation"] = _make_continuation
|
||||
env["continuation?"] = lambda x: isinstance(x, Continuation)
|
||||
env["continuation-fn"] = lambda c: c.fn
|
||||
|
||||
def _make_cek_continuation(captured, rest_kont):
|
||||
"""Create a Continuation that stores captured CEK frames as data."""
|
||||
data = {"captured": captured, "rest-kont": rest_kont}
|
||||
# The fn is a dummy — invocation happens via CEK's continue-with-call
|
||||
return Continuation(lambda v=NIL: v)
|
||||
|
||||
# Monkey-patch to store data
|
||||
_orig_make_cek_cont = _make_cek_continuation
|
||||
def _make_cek_continuation_with_data(captured, rest_kont):
|
||||
c = _orig_make_cek_cont(captured, rest_kont)
|
||||
c._cek_data = {"captured": captured, "rest-kont": rest_kont}
|
||||
return c
|
||||
|
||||
env["make-cek-continuation"] = _make_cek_continuation_with_data
|
||||
env["continuation-data"] = lambda c: getattr(c, '_cek_data', {})
|
||||
|
||||
# Register platform functions from sx_ref that cek.sx and eval.sx need
|
||||
# These are normally available as transpiled Python but need to be in the
|
||||
# SX env when interpreting .sx files directly.
|
||||
|
||||
# Type predicates and constructors
|
||||
env["callable?"] = lambda x: callable(x) or isinstance(x, (Lambda, Component, Island, Continuation))
|
||||
env["lambda?"] = lambda x: isinstance(x, Lambda)
|
||||
env["component?"] = lambda x: isinstance(x, Component)
|
||||
env["island?"] = lambda x: isinstance(x, Island)
|
||||
env["macro?"] = lambda x: isinstance(x, Macro)
|
||||
env["thunk?"] = sx_ref.is_thunk
|
||||
env["thunk-expr"] = sx_ref.thunk_expr
|
||||
env["thunk-env"] = sx_ref.thunk_env
|
||||
env["make-thunk"] = sx_ref.make_thunk
|
||||
env["make-lambda"] = sx_ref.make_lambda
|
||||
env["make-component"] = sx_ref.make_component
|
||||
env["make-island"] = sx_ref.make_island
|
||||
env["make-macro"] = sx_ref.make_macro
|
||||
env["make-symbol"] = lambda n: Symbol(n)
|
||||
env["lambda-params"] = lambda f: f.params
|
||||
env["lambda-body"] = lambda f: f.body
|
||||
env["lambda-closure"] = lambda f: f.closure
|
||||
env["lambda-name"] = lambda f: f.name
|
||||
env["set-lambda-name!"] = lambda f, n: setattr(f, 'name', n) or NIL
|
||||
env["component-params"] = lambda c: c.params
|
||||
env["component-body"] = lambda c: c.body
|
||||
env["component-closure"] = lambda c: c.closure
|
||||
env["component-has-children?"] = lambda c: c.has_children
|
||||
env["component-affinity"] = lambda c: getattr(c, 'affinity', 'auto')
|
||||
env["component-set-param-types!"] = lambda c, t: setattr(c, 'param_types', t) or NIL
|
||||
env["macro-params"] = lambda m: m.params
|
||||
env["macro-rest-param"] = lambda m: m.rest_param
|
||||
env["macro-body"] = lambda m: m.body
|
||||
env["macro-closure"] = lambda m: m.closure
|
||||
env["env-merge"] = env_merge
|
||||
env["symbol-name"] = lambda s: s.name if isinstance(s, Symbol) else str(s)
|
||||
env["keyword-name"] = lambda k: k.name if isinstance(k, Keyword) else str(k)
|
||||
env["type-of"] = sx_ref.type_of
|
||||
env["primitive?"] = lambda n: n in sx_ref.PRIMITIVES
|
||||
env["get-primitive"] = lambda n: sx_ref.PRIMITIVES.get(n)
|
||||
env["strip-prefix"] = lambda s, p: s[len(p):] if s.startswith(p) else s
|
||||
env["inspect"] = repr
|
||||
env["debug-log"] = lambda *args: None
|
||||
env["error"] = sx_ref.error
|
||||
env["apply"] = lambda f, args: f(*args)
|
||||
|
||||
# Functions from eval.sx that cek.sx references
|
||||
env["trampoline"] = trampoline
|
||||
env["eval-expr"] = eval_expr
|
||||
env["eval-list"] = sx_ref.eval_list
|
||||
env["eval-call"] = sx_ref.eval_call
|
||||
env["call-lambda"] = sx_ref.call_lambda
|
||||
env["call-component"] = sx_ref.call_component
|
||||
env["parse-keyword-args"] = sx_ref.parse_keyword_args
|
||||
env["sf-lambda"] = sx_ref.sf_lambda
|
||||
env["sf-defcomp"] = sx_ref.sf_defcomp
|
||||
env["sf-defisland"] = sx_ref.sf_defisland
|
||||
env["sf-defmacro"] = sx_ref.sf_defmacro
|
||||
env["sf-defstyle"] = sx_ref.sf_defstyle
|
||||
env["sf-deftype"] = sx_ref.sf_deftype
|
||||
env["sf-defeffect"] = sx_ref.sf_defeffect
|
||||
env["sf-letrec"] = sx_ref.sf_letrec
|
||||
env["sf-named-let"] = sx_ref.sf_named_let
|
||||
env["sf-dynamic-wind"] = sx_ref.sf_dynamic_wind
|
||||
env["sf-scope"] = sx_ref.sf_scope
|
||||
env["sf-provide"] = sx_ref.sf_provide
|
||||
env["qq-expand"] = sx_ref.qq_expand
|
||||
env["expand-macro"] = sx_ref.expand_macro
|
||||
env["cond-scheme?"] = sx_ref.cond_scheme_p
|
||||
|
||||
# Higher-order form handlers
|
||||
env["ho-map"] = sx_ref.ho_map
|
||||
env["ho-map-indexed"] = sx_ref.ho_map_indexed
|
||||
env["ho-filter"] = sx_ref.ho_filter
|
||||
env["ho-reduce"] = sx_ref.ho_reduce
|
||||
env["ho-some"] = sx_ref.ho_some
|
||||
env["ho-every"] = sx_ref.ho_every
|
||||
env["ho-for-each"] = sx_ref.ho_for_each
|
||||
env["call-fn"] = sx_ref.call_fn
|
||||
|
||||
# Render-related (stub for testing — no active rendering)
|
||||
env["render-active?"] = lambda: False
|
||||
env["is-render-expr?"] = lambda expr: False
|
||||
env["render-expr"] = lambda expr, env: NIL
|
||||
|
||||
# Scope primitives
|
||||
env["scope-push!"] = sx_ref.PRIMITIVES.get("scope-push!", lambda *a: NIL)
|
||||
env["scope-pop!"] = sx_ref.PRIMITIVES.get("scope-pop!", lambda *a: NIL)
|
||||
env["context"] = sx_ref.PRIMITIVES.get("context", lambda *a: NIL)
|
||||
env["emit!"] = sx_ref.PRIMITIVES.get("emit!", lambda *a: NIL)
|
||||
env["emitted"] = sx_ref.PRIMITIVES.get("emitted", lambda *a: [])
|
||||
|
||||
# Dynamic wind
|
||||
env["push-wind!"] = lambda before, after: NIL
|
||||
env["pop-wind!"] = lambda: NIL
|
||||
env["call-thunk"] = lambda f, e: f() if callable(f) else trampoline(eval_expr([f], e))
|
||||
|
||||
# Mutation helpers used by parse-keyword-args etc
|
||||
env["dict-get"] = lambda d, k: d.get(k, NIL) if isinstance(d, dict) else NIL
|
||||
|
||||
# defhandler, defpage, defquery, defaction — these are registrations
|
||||
# Use the bootstrapped versions if they exist, otherwise stub
|
||||
for name in ["sf-defhandler", "sf-defpage", "sf-defquery", "sf-defaction"]:
|
||||
pyname = name.replace("-", "_")
|
||||
fn = getattr(sx_ref, pyname, None)
|
||||
if fn:
|
||||
env[name] = fn
|
||||
else:
|
||||
env[name] = lambda args, e, _n=name: NIL
|
||||
|
||||
# Load test framework
|
||||
with open(os.path.join(_SPEC_TESTS, "test-framework.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Load frames module
|
||||
print("Loading frames.sx ...")
|
||||
with open(os.path.join(_PROJECT, "spec", "frames.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Load CEK module
|
||||
print("Loading cek.sx ...")
|
||||
with open(os.path.join(_PROJECT, "spec", "cek.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Define cek-eval helper in SX
|
||||
for expr in parse_all("""
|
||||
(define cek-eval
|
||||
(fn (source)
|
||||
(let ((exprs (sx-parse source)))
|
||||
(let ((result nil))
|
||||
(for-each (fn (e) (set! result (eval-expr-cek e (test-env)))) exprs)
|
||||
result))))
|
||||
"""):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Run tests
|
||||
print("=" * 60)
|
||||
print("Running test-cek.sx")
|
||||
print("=" * 60)
|
||||
|
||||
with open(os.path.join(_SPEC_TESTS, "test-cek.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
print("=" * 60)
|
||||
print(f"Results: {_pass_count} passed, {_fail_count} failed")
|
||||
print("=" * 60)
|
||||
sys.exit(1 if _fail_count > 0 else 0)
|
||||
108
hosts/python/tests/run_continuation_tests.py
Normal file
108
hosts/python/tests/run_continuation_tests.py
Normal file
@@ -0,0 +1,108 @@
|
||||
#!/usr/bin/env python3
|
||||
"""Run test-continuations.sx using the bootstrapped evaluator with continuations enabled."""
|
||||
from __future__ import annotations
|
||||
import os, sys, subprocess, tempfile
|
||||
|
||||
_HERE = os.path.dirname(os.path.abspath(__file__))
|
||||
_PROJECT = os.path.abspath(os.path.join(_HERE, "..", "..", ".."))
|
||||
_SPEC_TESTS = os.path.join(_PROJECT, "spec", "tests")
|
||||
_WEB_TESTS = os.path.join(_PROJECT, "web", "tests")
|
||||
sys.path.insert(0, _PROJECT)
|
||||
|
||||
# Bootstrap a fresh sx_ref with continuations enabled
|
||||
print("Bootstrapping with --extensions continuations ...")
|
||||
result = subprocess.run(
|
||||
[sys.executable, os.path.join(_HERE, "..", "bootstrap.py"),
|
||||
"--extensions", "continuations"],
|
||||
capture_output=True, text=True, cwd=_PROJECT,
|
||||
)
|
||||
if result.returncode != 0:
|
||||
print("Bootstrap FAILED:")
|
||||
print(result.stderr)
|
||||
sys.exit(1)
|
||||
|
||||
# Write to temp file and import
|
||||
tmp = tempfile.NamedTemporaryFile(mode="w", suffix=".py", delete=False, dir=_HERE)
|
||||
tmp.write(result.stdout)
|
||||
tmp.close()
|
||||
|
||||
try:
|
||||
import importlib.util
|
||||
spec = importlib.util.spec_from_file_location("sx_ref_cont", tmp.name)
|
||||
mod = importlib.util.module_from_spec(spec)
|
||||
spec.loader.exec_module(mod)
|
||||
finally:
|
||||
os.unlink(tmp.name)
|
||||
|
||||
from shared.sx.types import NIL
|
||||
parse_all = mod.sx_parse
|
||||
|
||||
# Use tree-walk evaluator for interpreting .sx test files.
|
||||
# CEK is now the default, but test runners need tree-walk so that
|
||||
# transpiled HO forms (ho_map, etc.) don't re-enter CEK mid-evaluation.
|
||||
eval_expr = mod._tree_walk_eval_expr
|
||||
trampoline = mod._tree_walk_trampoline
|
||||
mod.eval_expr = eval_expr
|
||||
mod.trampoline = trampoline
|
||||
env = mod.make_env()
|
||||
|
||||
# Platform test functions
|
||||
_suite_stack: list[str] = []
|
||||
_pass_count = 0
|
||||
_fail_count = 0
|
||||
|
||||
def _try_call(thunk):
|
||||
try:
|
||||
trampoline(eval_expr([thunk], env))
|
||||
return {"ok": True}
|
||||
except Exception as e:
|
||||
return {"ok": False, "error": str(e)}
|
||||
|
||||
def _report_pass(name):
|
||||
global _pass_count
|
||||
_pass_count += 1
|
||||
ctx = " > ".join(_suite_stack)
|
||||
print(f" PASS: {ctx} > {name}")
|
||||
return NIL
|
||||
|
||||
def _report_fail(name, error):
|
||||
global _fail_count
|
||||
_fail_count += 1
|
||||
ctx = " > ".join(_suite_stack)
|
||||
print(f" FAIL: {ctx} > {name}: {error}")
|
||||
return NIL
|
||||
|
||||
def _push_suite(name):
|
||||
_suite_stack.append(name)
|
||||
print(f"{' ' * (len(_suite_stack)-1)}Suite: {name}")
|
||||
return NIL
|
||||
|
||||
def _pop_suite():
|
||||
if _suite_stack:
|
||||
_suite_stack.pop()
|
||||
return NIL
|
||||
|
||||
env["try-call"] = _try_call
|
||||
env["report-pass"] = _report_pass
|
||||
env["report-fail"] = _report_fail
|
||||
env["push-suite"] = _push_suite
|
||||
env["pop-suite"] = _pop_suite
|
||||
|
||||
# Load test framework
|
||||
with open(os.path.join(_SPEC_TESTS, "test-framework.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Run tests
|
||||
print("=" * 60)
|
||||
print("Running test-continuations.sx")
|
||||
print("=" * 60)
|
||||
|
||||
with open(os.path.join(_SPEC_TESTS, "test-continuations.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
print("=" * 60)
|
||||
print(f"Results: {_pass_count} passed, {_fail_count} failed")
|
||||
print("=" * 60)
|
||||
sys.exit(1 if _fail_count > 0 else 0)
|
||||
164
hosts/python/tests/run_signal_tests.py
Normal file
164
hosts/python/tests/run_signal_tests.py
Normal file
@@ -0,0 +1,164 @@
|
||||
#!/usr/bin/env python3
|
||||
"""Run test-signals.sx using the bootstrapped evaluator with signal primitives.
|
||||
|
||||
Uses bootstrapped signal functions from sx_ref.py directly, patching apply
|
||||
to handle SX lambdas from the interpreter (test expressions create lambdas
|
||||
that need evaluator dispatch).
|
||||
"""
|
||||
from __future__ import annotations
|
||||
import os, sys
|
||||
|
||||
_HERE = os.path.dirname(os.path.abspath(__file__))
|
||||
_PROJECT = os.path.abspath(os.path.join(_HERE, "..", "..", ".."))
|
||||
_SPEC_TESTS = os.path.join(_PROJECT, "spec", "tests")
|
||||
_WEB_TESTS = os.path.join(_PROJECT, "web", "tests")
|
||||
sys.path.insert(0, _PROJECT)
|
||||
|
||||
from shared.sx.ref.sx_ref import sx_parse as parse_all
|
||||
from shared.sx.ref import sx_ref
|
||||
from shared.sx.ref.sx_ref import make_env, scope_push, scope_pop, sx_context
|
||||
from shared.sx.types import NIL, Island, Lambda
|
||||
# Use tree-walk evaluator for interpreting .sx test files.
|
||||
eval_expr = sx_ref._tree_walk_eval_expr
|
||||
trampoline = sx_ref._tree_walk_trampoline
|
||||
sx_ref.eval_expr = eval_expr
|
||||
sx_ref.trampoline = trampoline
|
||||
|
||||
# Build env with primitives
|
||||
env = make_env()
|
||||
|
||||
# --- Patch apply BEFORE anything else ---
|
||||
# Test expressions create SX Lambdas that bootstrapped code calls via apply.
|
||||
# Patch the module-level function so all bootstrapped functions see it.
|
||||
|
||||
# apply is used by swap! and other forms to call functions with arg lists
|
||||
def _apply(f, args):
|
||||
if isinstance(f, Lambda):
|
||||
return trampoline(eval_expr([f] + list(args), env))
|
||||
return f(*args)
|
||||
sx_ref.__dict__["apply"] = _apply
|
||||
|
||||
# cons needs to handle tuples from Python *args (swap! passes &rest as tuple)
|
||||
_orig_cons = sx_ref.PRIMITIVES.get("cons")
|
||||
def _cons(x, c):
|
||||
if isinstance(c, tuple):
|
||||
c = list(c)
|
||||
return [x] + (c or [])
|
||||
sx_ref.__dict__["cons"] = _cons
|
||||
sx_ref.PRIMITIVES["cons"] = _cons
|
||||
|
||||
# Platform test functions
|
||||
_suite_stack: list[str] = []
|
||||
_pass_count = 0
|
||||
_fail_count = 0
|
||||
|
||||
def _try_call(thunk):
|
||||
try:
|
||||
trampoline(eval_expr([thunk], env))
|
||||
return {"ok": True}
|
||||
except Exception as e:
|
||||
return {"ok": False, "error": str(e)}
|
||||
|
||||
def _report_pass(name):
|
||||
global _pass_count
|
||||
_pass_count += 1
|
||||
ctx = " > ".join(_suite_stack)
|
||||
print(f" PASS: {ctx} > {name}")
|
||||
return NIL
|
||||
|
||||
def _report_fail(name, error):
|
||||
global _fail_count
|
||||
_fail_count += 1
|
||||
ctx = " > ".join(_suite_stack)
|
||||
print(f" FAIL: {ctx} > {name}: {error}")
|
||||
return NIL
|
||||
|
||||
def _push_suite(name):
|
||||
_suite_stack.append(name)
|
||||
print(f"{' ' * (len(_suite_stack)-1)}Suite: {name}")
|
||||
return NIL
|
||||
|
||||
def _pop_suite():
|
||||
if _suite_stack:
|
||||
_suite_stack.pop()
|
||||
return NIL
|
||||
|
||||
env["try-call"] = _try_call
|
||||
env["report-pass"] = _report_pass
|
||||
env["report-fail"] = _report_fail
|
||||
env["push-suite"] = _push_suite
|
||||
env["pop-suite"] = _pop_suite
|
||||
|
||||
# Signal functions are now pure SX (transpiled into sx_ref.py from signals.sx)
|
||||
# Wire both low-level dict-based signal functions and high-level API
|
||||
env["identical?"] = sx_ref.is_identical
|
||||
env["island?"] = lambda x: isinstance(x, Island)
|
||||
|
||||
# Scope primitives (used by signals.sx for reactive tracking)
|
||||
env["scope-push!"] = scope_push
|
||||
env["scope-pop!"] = scope_pop
|
||||
env["context"] = sx_context
|
||||
|
||||
# Low-level signal functions (now pure SX, transpiled from signals.sx)
|
||||
env["make-signal"] = sx_ref.make_signal
|
||||
env["signal?"] = sx_ref.is_signal
|
||||
env["signal-value"] = sx_ref.signal_value
|
||||
env["signal-set-value!"] = sx_ref.signal_set_value
|
||||
env["signal-subscribers"] = sx_ref.signal_subscribers
|
||||
env["signal-add-sub!"] = sx_ref.signal_add_sub
|
||||
env["signal-remove-sub!"] = sx_ref.signal_remove_sub
|
||||
env["signal-deps"] = sx_ref.signal_deps
|
||||
env["signal-set-deps!"] = sx_ref.signal_set_deps
|
||||
|
||||
# Bootstrapped signal functions from sx_ref.py
|
||||
env["signal"] = sx_ref.signal
|
||||
env["deref"] = sx_ref.deref
|
||||
env["reset!"] = sx_ref.reset_b
|
||||
env["swap!"] = sx_ref.swap_b
|
||||
env["computed"] = sx_ref.computed
|
||||
env["effect"] = sx_ref.effect
|
||||
# batch has a bootstrapper issue with _batch_depth global variable access.
|
||||
# Wrap it to work correctly in the test context.
|
||||
def _batch(thunk):
|
||||
sx_ref._batch_depth = getattr(sx_ref, '_batch_depth', 0) + 1
|
||||
sx_ref.cek_call(thunk, None)
|
||||
sx_ref._batch_depth -= 1
|
||||
if sx_ref._batch_depth == 0:
|
||||
queue = list(sx_ref._batch_queue)
|
||||
sx_ref._batch_queue = []
|
||||
seen = []
|
||||
pending = []
|
||||
for s in queue:
|
||||
for sub in sx_ref.signal_subscribers(s):
|
||||
if sub not in seen:
|
||||
seen.append(sub)
|
||||
pending.append(sub)
|
||||
for sub in pending:
|
||||
sub()
|
||||
return NIL
|
||||
env["batch"] = _batch
|
||||
env["notify-subscribers"] = sx_ref.notify_subscribers
|
||||
env["flush-subscribers"] = sx_ref.flush_subscribers
|
||||
env["dispose-computed"] = sx_ref.dispose_computed
|
||||
env["with-island-scope"] = sx_ref.with_island_scope
|
||||
env["register-in-scope"] = sx_ref.register_in_scope
|
||||
env["callable?"] = sx_ref.is_callable
|
||||
|
||||
# Load test framework
|
||||
with open(os.path.join(_SPEC_TESTS, "test-framework.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Run tests
|
||||
print("=" * 60)
|
||||
print("Running test-signals.sx")
|
||||
print("=" * 60)
|
||||
|
||||
with open(os.path.join(_WEB_TESTS, "test-signals.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
print("=" * 60)
|
||||
print(f"Results: {_pass_count} passed, {_fail_count} failed")
|
||||
print("=" * 60)
|
||||
sys.exit(1 if _fail_count > 0 else 0)
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user