Compare commits
562 Commits
b8d3e46a9b
...
main
| Author | SHA1 | Date | |
|---|---|---|---|
| 6417d15e60 | |||
| 99e2009c2b | |||
| 73810d249d | |||
| 1ae5906ff6 | |||
| 2bc1aee888 | |||
| 4dfaf09e04 | |||
| 7ac026eccb | |||
| b174a57c9c | |||
| 1b5d3e8eb1 | |||
| 0fce6934cb | |||
| 7d7de86034 | |||
| f3f70cc00b | |||
| 50871780a3 | |||
| 57cffb8bcc | |||
| eb4233ff36 | |||
| 5b2ef0a2af | |||
| 32df71abd4 | |||
| 91cf39153b | |||
| 953f0ec744 | |||
| 13ba5ee423 | |||
| a6e0e84521 | |||
| 3ae49b69f5 | |||
| 2d8741779e | |||
| 945b4c1dd7 | |||
| 33af6b9266 | |||
| c8280e156f | |||
| 732d733eac | |||
| 3df8c41ca1 | |||
| 6ef9688bd2 | |||
| f9f810ffd7 | |||
| e887c0d978 | |||
| 7434de53a6 | |||
| d735e28b39 | |||
| 482bc0ca5e | |||
| aa88c06c00 | |||
| ee868f686b | |||
| 96f2862385 | |||
| 26e16f6aa4 | |||
| 9caf8b6e94 | |||
| 8e6e7dce43 | |||
| bc7da977a0 | |||
| efb2d92b99 | |||
| 89543e0152 | |||
| 0c7567925e | |||
| 2a9a4b41bd | |||
| 8a08de26cd | |||
| 8ccf5f7c1e | |||
| bf305deae1 | |||
| e021184935 | |||
| 55061d6451 | |||
| ce9c5d3a08 | |||
| 49fd4a51d6 | |||
| 7d793ec76c | |||
| e4cabcbb59 | |||
| 284572c7a9 | |||
| 70a58bddd8 | |||
| 23c8b97cb1 | |||
| 5270d2e956 | |||
| dd057247a5 | |||
| 8958714c85 | |||
| 30cfbf777a | |||
| ffe849df8e | |||
| 49b03b246d | |||
| 33a02c8fe1 | |||
| a823e59376 | |||
| 96f50b9dfa | |||
| 890c472893 | |||
| 5cfeed81c1 | |||
| 2727a2ed8c | |||
| 6e804bbb5c | |||
| c4224925f9 | |||
| fe84b57bed | |||
| 5b370b69e3 | |||
| 639a6a2a53 | |||
| 3cce3df5b0 | |||
| 9ff913c312 | |||
| b1de591e9e | |||
| 364fbac9e1 | |||
| 8f2a51af9d | |||
| fa700e0202 | |||
| f4610e1799 | |||
| f3c0cbd8e2 | |||
| 6e1d28d1d7 | |||
| 2c8afd230d | |||
| 92bfef6406 | |||
| 894321db18 | |||
| 9bd4863ce1 | |||
| 2a5ef0ea09 | |||
| 1cc3e761a2 | |||
| e12b2eab6b | |||
| 09feb51762 | |||
| 4734d38f3b | |||
| a716e3f745 | |||
| 318c818728 | |||
| 7628659854 | |||
| bb34b4948b | |||
| df461beec2 | |||
| 6d73edf297 | |||
| 373a4f0134 | |||
| ae0e87fbf8 | |||
| 8dd3eaa1d9 | |||
| e6663a74ba | |||
| 231bfbecb5 | |||
| df256b5607 | |||
| 0ce23521b7 | |||
| c79aa880af | |||
| f12bbae6c9 | |||
| c8c4b322a9 | |||
| e7da397f8e | |||
| 1bb40415a8 | |||
| a62b7c8a5e | |||
| ceb2adfe50 | |||
| 5ca2ee92bc | |||
| e14fc9b0e1 | |||
| a8d1163aa6 | |||
| c8533181ab | |||
| 40d0f1a438 | |||
| d9e80d8544 | |||
| c16142d14c | |||
| 8707f21ca2 | |||
| 96e7bbbac1 | |||
| d3b3b4b720 | |||
| f819fda587 | |||
| d06de87bca | |||
| 109ca7c70b | |||
| 171c18d3be | |||
| 1c91680e63 | |||
| e61dc4974b | |||
| 8373c6cf16 | |||
| fac97883f9 | |||
| 71c2003a60 | |||
| 5b6e883e6d | |||
| 2203f56849 | |||
| ecbe670a6a | |||
| f9e65e1d17 | |||
| 4c54843542 | |||
| f7e4e3d762 | |||
| 4308591982 | |||
| 4ce4762237 | |||
| 06666ac8c4 | |||
| 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 |
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.
|
||||
@@ -0,0 +1,17 @@
|
||||
---
|
||||
name: SX navigation single-source-of-truth
|
||||
description: Navigation must be defined once in nav-data.sx — no fragment URLs, no duplicated case statements, use make-page-fn for convention-based routing
|
||||
type: feedback
|
||||
---
|
||||
|
||||
Never use fragment URLs (#anchors) in the SX docs nav system. Every navigable item must have its own Lisp URL.
|
||||
|
||||
**Why:** Fragment URLs don't work with the SX URL routing system — fragments are client-side only and never reach the server, so nav resolution can't identify the current page.
|
||||
|
||||
**How to apply:**
|
||||
- `nav-data.sx` is the single source of truth for all navigation labels, hrefs, summaries, and hierarchy
|
||||
- `page-functions.sx` uses `make-page-fn` (convention-based) or `slug->component` to derive component names from slugs — no hand-written case statements for simple pages
|
||||
- Overview/index pages should generate link lists from nav-data variables (e.g. `reactive-examples-nav-items`) rather than hardcoding URLs
|
||||
- To add a new simple page: add nav item to nav-data.sx, create the component file. That's it — the naming convention handles routing.
|
||||
- Pages that need server-side data fetching (reference, spec, test, bootstrapper, isomorphism) still use custom functions with explicit case clauses
|
||||
- Legacy Python nav lists in `content/pages.py` have been removed — nav-data.sx is canonical
|
||||
@@ -1,5 +1,5 @@
|
||||
.git
|
||||
.gitea
|
||||
.gitea/workflows
|
||||
.env
|
||||
_snapshot
|
||||
docs
|
||||
|
||||
85
.gitea/Dockerfile.test
Normal file
85
.gitea/Dockerfile.test
Normal file
@@ -0,0 +1,85 @@
|
||||
# syntax=docker/dockerfile:1
|
||||
#
|
||||
# CI test image — Python 3 + Node.js + OCaml 5.2 + dune.
|
||||
#
|
||||
# Build chain:
|
||||
# 1. Compile OCaml from checked-in sx_ref.ml — produces sx_server.exe
|
||||
# 2. Bootstrap JS (sx-browser.js) — OcamlSync transpiler → JS
|
||||
# 3. Re-bootstrap OCaml (sx_ref.ml) — OcamlSync transpiler → OCaml
|
||||
# 4. Recompile OCaml with fresh sx_ref.ml — final native binary
|
||||
#
|
||||
# Test suites (run at CMD):
|
||||
# - JS standard + full tests — Node
|
||||
# - OCaml spec tests — native binary
|
||||
# - OCaml bridge integration tests — Python + OCaml subprocess
|
||||
#
|
||||
# Usage:
|
||||
# docker build -f .gitea/Dockerfile.test -t sx-test .
|
||||
# docker run --rm sx-test
|
||||
|
||||
FROM ocaml/opam:debian-12-ocaml-5.2
|
||||
|
||||
USER root
|
||||
RUN apt-get update && apt-get install -y --no-install-recommends \
|
||||
python3 ca-certificates curl xz-utils \
|
||||
&& rm -rf /var/lib/apt/lists/*
|
||||
# Node.js — direct binary (avoids the massive Debian nodejs dep tree)
|
||||
RUN NODE_VERSION=22.22.1 \
|
||||
&& ARCH=$(dpkg --print-architecture | sed 's/amd64/x64/;s/arm64/arm64/;s/armhf/armv7l/') \
|
||||
&& curl -fsSL "https://nodejs.org/dist/v${NODE_VERSION}/node-v${NODE_VERSION}-linux-${ARCH}.tar.xz" \
|
||||
| tar -xJ --strip-components=1 -C /usr/local
|
||||
USER opam
|
||||
|
||||
# Install dune into the opam switch
|
||||
RUN opam install dune -y
|
||||
|
||||
# Bake the opam switch PATH into the image so dune/ocamlfind work in RUN
|
||||
ENV PATH="/home/opam/.opam/5.2/bin:${PATH}"
|
||||
|
||||
WORKDIR /home/opam/project
|
||||
|
||||
# Copy OCaml sources first (changes less often → better caching)
|
||||
COPY --chown=opam:opam hosts/ocaml/dune-project ./hosts/ocaml/
|
||||
COPY --chown=opam:opam hosts/ocaml/lib/ ./hosts/ocaml/lib/
|
||||
COPY --chown=opam:opam hosts/ocaml/bin/ ./hosts/ocaml/bin/
|
||||
|
||||
# Copy spec, lib, web, shared (needed by bootstrappers + tests)
|
||||
COPY --chown=opam:opam spec/ ./spec/
|
||||
COPY --chown=opam:opam lib/ ./lib/
|
||||
COPY --chown=opam:opam web/ ./web/
|
||||
COPY --chown=opam:opam shared/sx/ ./shared/sx/
|
||||
COPY --chown=opam:opam shared/__init__.py ./shared/__init__.py
|
||||
|
||||
# Copy JS host (bootstrapper + test runner)
|
||||
COPY --chown=opam:opam hosts/javascript/ ./hosts/javascript/
|
||||
|
||||
# Copy OCaml host (bootstrapper + transpiler)
|
||||
COPY --chown=opam:opam hosts/ocaml/bootstrap.py ./hosts/ocaml/bootstrap.py
|
||||
COPY --chown=opam:opam hosts/ocaml/transpiler.sx ./hosts/ocaml/transpiler.sx
|
||||
|
||||
# Create output directory for JS builds
|
||||
RUN mkdir -p shared/static/scripts
|
||||
|
||||
# Step 1: Compile OCaml from checked-in sx_ref.ml
|
||||
# → produces sx_server.exe (needed by both JS and OCaml bootstrappers)
|
||||
RUN cd hosts/ocaml && dune build
|
||||
|
||||
# Step 2: Bootstrap JS (uses sx_server.exe via OcamlSync)
|
||||
RUN python3 hosts/javascript/cli.py \
|
||||
--output shared/static/scripts/sx-browser.js \
|
||||
&& python3 hosts/javascript/cli.py \
|
||||
--extensions continuations --spec-modules types \
|
||||
--output shared/static/scripts/sx-full-test.js
|
||||
|
||||
# Step 3: Re-bootstrap OCaml (transpile current spec → fresh sx_ref.ml)
|
||||
RUN python3 hosts/ocaml/bootstrap.py \
|
||||
--output hosts/ocaml/lib/sx_ref.ml
|
||||
|
||||
# Step 4: Recompile OCaml with freshly bootstrapped sx_ref.ml
|
||||
RUN cd hosts/ocaml && dune build
|
||||
|
||||
# Default: run all tests
|
||||
COPY --chown=opam:opam .gitea/run-ci-tests.sh ./run-ci-tests.sh
|
||||
RUN chmod +x run-ci-tests.sh
|
||||
|
||||
CMD ["./run-ci-tests.sh"]
|
||||
115
.gitea/run-ci-tests.sh
Executable file
115
.gitea/run-ci-tests.sh
Executable file
@@ -0,0 +1,115 @@
|
||||
#!/usr/bin/env bash
|
||||
# ===========================================================================
|
||||
# run-ci-tests.sh — CI test runner for SX language suite.
|
||||
#
|
||||
# Runs JS + OCaml tests. No Python evaluator (eliminated).
|
||||
# Exit non-zero if any suite fails.
|
||||
# ===========================================================================
|
||||
set -euo pipefail
|
||||
|
||||
FAILURES=()
|
||||
PASSES=()
|
||||
|
||||
run_suite() {
|
||||
local name="$1"
|
||||
shift
|
||||
echo ""
|
||||
echo "============================================================"
|
||||
echo " $name"
|
||||
echo "============================================================"
|
||||
if "$@"; then
|
||||
PASSES+=("$name")
|
||||
else
|
||||
FAILURES+=("$name")
|
||||
fi
|
||||
}
|
||||
|
||||
# -------------------------------------------------------------------
|
||||
# 1. JS standard tests
|
||||
# -------------------------------------------------------------------
|
||||
run_suite "JS standard (spec tests)" \
|
||||
node hosts/javascript/run_tests.js
|
||||
|
||||
# -------------------------------------------------------------------
|
||||
# 2. JS full tests (continuations + types + VM)
|
||||
# -------------------------------------------------------------------
|
||||
run_suite "JS full (spec + continuations + types + VM)" \
|
||||
node hosts/javascript/run_tests.js --full
|
||||
|
||||
# -------------------------------------------------------------------
|
||||
# 3. OCaml spec tests
|
||||
# -------------------------------------------------------------------
|
||||
run_suite "OCaml (spec tests)" \
|
||||
hosts/ocaml/_build/default/bin/run_tests.exe
|
||||
|
||||
# -------------------------------------------------------------------
|
||||
# 4. OCaml bridge integration (custom special forms, web-forms.sx)
|
||||
# -------------------------------------------------------------------
|
||||
run_suite "OCaml bridge — custom special forms + web-forms" \
|
||||
python3 -c "
|
||||
from shared.sx.ocaml_sync import OcamlSync
|
||||
bridge = OcamlSync()
|
||||
for f in ['spec/parser.sx', 'spec/render.sx', 'web/adapter-html.sx', 'web/adapter-sx.sx', 'web/web-forms.sx', 'lib/freeze.sx']:
|
||||
bridge.load(f)
|
||||
ok = 0; fail = 0
|
||||
def check(name, expr, expected=None):
|
||||
global ok, fail
|
||||
try:
|
||||
r = bridge.eval(expr)
|
||||
if expected is not None and r != expected:
|
||||
print(f' FAIL: {name}: expected {expected!r}, got {r!r}'); fail += 1
|
||||
else:
|
||||
print(f' PASS: {name}'); ok += 1
|
||||
except Exception as e:
|
||||
print(f' FAIL: {name}: {e}'); fail += 1
|
||||
|
||||
for form in ['defhandler', 'defquery', 'defaction', 'defpage', 'defrelation', 'defstyle', 'deftype', 'defeffect']:
|
||||
check(f'{form} registered', f'(has-key? *custom-special-forms* \"{form}\")', 'true')
|
||||
|
||||
check('deftype via eval', '(deftype test-t number)', 'nil')
|
||||
check('defeffect via eval', '(defeffect test-e)', 'nil')
|
||||
check('defstyle via eval', '(defstyle my-s \"bold\")', 'bold')
|
||||
check('defhandler via eval', '(has-key? (defhandler test-h (&key x) x) \"__type\")', 'true')
|
||||
|
||||
check('definition-form-extensions populated', '(> (len *definition-form-extensions*) 0)', 'true')
|
||||
check('RENDER_HTML_FORMS has defstyle', '(contains? RENDER_HTML_FORMS \"defstyle\")', 'true')
|
||||
|
||||
bridge2 = OcamlSync()
|
||||
bridge2.eval('(register-special-form! \"shadow-test\" (fn (args env) 42))')
|
||||
bridge2.load('spec/evaluator.sx')
|
||||
check('custom form survives evaluator.sx load',
|
||||
bridge2.eval('(has-key? *custom-special-forms* \"shadow-test\")'), 'true')
|
||||
bridge2.eval('(register-special-form! \"post-load\" (fn (args env) 99))')
|
||||
check('custom form callable after evaluator.sx load',
|
||||
bridge2.eval('(post-load 1)'), '99')
|
||||
|
||||
print(f'\nResults: {ok} passed, {fail} failed')
|
||||
import sys; sys.exit(1 if fail > 0 else 0)
|
||||
"
|
||||
|
||||
# -------------------------------------------------------------------
|
||||
# Summary
|
||||
# -------------------------------------------------------------------
|
||||
echo ""
|
||||
echo "============================================================"
|
||||
echo " CI TEST SUMMARY"
|
||||
echo "============================================================"
|
||||
for p in "${PASSES[@]}"; do
|
||||
echo " PASS: $p"
|
||||
done
|
||||
for f in "${FAILURES[@]}"; do
|
||||
echo " FAIL: $f"
|
||||
done
|
||||
echo "============================================================"
|
||||
|
||||
if [ ${#FAILURES[@]} -gt 0 ]; then
|
||||
echo ""
|
||||
echo " ${#FAILURES[@]} suite(s) FAILED"
|
||||
echo ""
|
||||
exit 1
|
||||
else
|
||||
echo ""
|
||||
echo " All ${#PASSES[@]} suites passed."
|
||||
echo ""
|
||||
exit 0
|
||||
fi
|
||||
@@ -1,4 +1,4 @@
|
||||
name: Build and Deploy
|
||||
name: Test, Build, and Deploy
|
||||
|
||||
on:
|
||||
push:
|
||||
@@ -7,9 +7,10 @@ on:
|
||||
env:
|
||||
REGISTRY: registry.rose-ash.com:5000
|
||||
APP_DIR: /root/rose-ash
|
||||
BUILD_DIR: /root/rose-ash-ci
|
||||
|
||||
jobs:
|
||||
build-and-deploy:
|
||||
test-build-deploy:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
@@ -28,28 +29,55 @@ jobs:
|
||||
chmod 600 ~/.ssh/id_rsa
|
||||
ssh-keyscan -H "$DEPLOY_HOST" >> ~/.ssh/known_hosts 2>/dev/null || true
|
||||
|
||||
- name: Sync CI build directory
|
||||
env:
|
||||
DEPLOY_HOST: ${{ secrets.DEPLOY_HOST }}
|
||||
run: |
|
||||
ssh "root@$DEPLOY_HOST" "
|
||||
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 }}
|
||||
"
|
||||
|
||||
- name: Test SX language suite
|
||||
env:
|
||||
DEPLOY_HOST: ${{ secrets.DEPLOY_HOST }}
|
||||
run: |
|
||||
ssh "root@$DEPLOY_HOST" "
|
||||
cd ${{ env.BUILD_DIR }}
|
||||
|
||||
echo '=== Building SX test image ==='
|
||||
docker build \
|
||||
-f .gitea/Dockerfile.test \
|
||||
-t sx-test:${{ github.sha }} \
|
||||
.
|
||||
|
||||
echo '=== Running SX tests ==='
|
||||
docker run --rm sx-test:${{ github.sha }}
|
||||
"
|
||||
|
||||
- name: Build and deploy changed apps
|
||||
env:
|
||||
DEPLOY_HOST: ${{ secrets.DEPLOY_HOST }}
|
||||
run: |
|
||||
ssh "root@$DEPLOY_HOST" "
|
||||
cd ${{ env.APP_DIR }}
|
||||
cd ${{ env.BUILD_DIR }}
|
||||
|
||||
# Save current HEAD before updating
|
||||
OLD_HEAD=\$(git rev-parse HEAD 2>/dev/null || echo none)
|
||||
# Detect changes using push event SHAs (not local checkout state)
|
||||
BEFORE='${{ github.event.before }}'
|
||||
AFTER='${{ github.sha }}'
|
||||
|
||||
git fetch origin ${{ github.ref_name }}
|
||||
git reset --hard origin/${{ github.ref_name }}
|
||||
|
||||
NEW_HEAD=\$(git rev-parse HEAD)
|
||||
|
||||
# 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 +114,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 +127,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))
|
||||
|
||||
|
||||
Binary file not shown.
@@ -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,
|
||||
|
||||
10
deploy.sh
10
deploy.sh
@@ -53,16 +53,10 @@ fi
|
||||
echo "Building: ${BUILD[*]}"
|
||||
echo ""
|
||||
|
||||
# --- Run unit tests before deploying ---
|
||||
echo "=== Running unit tests ==="
|
||||
docker build -f test/Dockerfile.unit -t rose-ash-test-unit:latest . -q
|
||||
if ! docker run --rm rose-ash-test-unit:latest; then
|
||||
echo ""
|
||||
echo "Unit tests FAILED — aborting deploy."
|
||||
# --- Run unit tests before deploying (skip Playwright — needs running server) ---
|
||||
if ! QUICK=true ./run-tests.sh; then
|
||||
exit 1
|
||||
fi
|
||||
echo "Unit tests passed."
|
||||
echo ""
|
||||
|
||||
for app in "${BUILD[@]}"; do
|
||||
dir=$(_app_dir "$app")
|
||||
|
||||
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
|
||||
71
docker-compose.dev-sx.yml
Normal file
71
docker-compose.dev-sx.yml
Normal file
@@ -0,0 +1,71 @@
|
||||
# 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"
|
||||
OCAMLRUNPARAM: "b"
|
||||
ports:
|
||||
- "8013:8000"
|
||||
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
|
||||
# Spec + lib + web SX files (loaded by OCaml kernel)
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
# 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
|
||||
@@ -12,6 +12,8 @@ x-dev-env: &dev-env
|
||||
WORKERS: "1"
|
||||
SX_USE_REF: "1"
|
||||
SX_BOUNDARY_STRICT: "1"
|
||||
SX_USE_OCAML: "1"
|
||||
SX_OCAML_BIN: "/app/bin/sx_server"
|
||||
|
||||
x-sibling-models: &sibling-models
|
||||
# Every app needs all sibling __init__.py + models/ for cross-domain SQLAlchemy imports
|
||||
@@ -44,6 +46,10 @@ services:
|
||||
volumes:
|
||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./blog/alembic.ini:/app/blog/alembic.ini:ro
|
||||
- ./blog/alembic:/app/blog/alembic:ro
|
||||
- ./blog/app.py:/app/app.py
|
||||
@@ -83,6 +89,10 @@ services:
|
||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||
- /root/rose-ash/_snapshot:/app/_snapshot
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./market/alembic.ini:/app/market/alembic.ini:ro
|
||||
- ./market/alembic:/app/market/alembic:ro
|
||||
- ./market/app.py:/app/app.py
|
||||
@@ -121,6 +131,10 @@ services:
|
||||
volumes:
|
||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./cart/alembic.ini:/app/cart/alembic.ini:ro
|
||||
- ./cart/alembic:/app/cart/alembic:ro
|
||||
- ./cart/app.py:/app/app.py
|
||||
@@ -159,6 +173,10 @@ services:
|
||||
volumes:
|
||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./events/alembic.ini:/app/events/alembic.ini:ro
|
||||
- ./events/alembic:/app/events/alembic:ro
|
||||
- ./events/app.py:/app/app.py
|
||||
@@ -197,6 +215,10 @@ services:
|
||||
volumes:
|
||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./federation/alembic.ini:/app/federation/alembic.ini:ro
|
||||
- ./federation/alembic:/app/federation/alembic:ro
|
||||
- ./federation/app.py:/app/app.py
|
||||
@@ -235,6 +257,10 @@ services:
|
||||
volumes:
|
||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./account/alembic.ini:/app/account/alembic.ini:ro
|
||||
- ./account/alembic:/app/account/alembic:ro
|
||||
- ./account/app.py:/app/app.py
|
||||
@@ -273,6 +299,10 @@ services:
|
||||
volumes:
|
||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./relations/alembic.ini:/app/relations/alembic.ini:ro
|
||||
- ./relations/alembic:/app/relations/alembic:ro
|
||||
- ./relations/app.py:/app/app.py
|
||||
@@ -304,6 +334,10 @@ services:
|
||||
volumes:
|
||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./likes/alembic.ini:/app/likes/alembic.ini:ro
|
||||
- ./likes/alembic:/app/likes/alembic:ro
|
||||
- ./likes/app.py:/app/app.py
|
||||
@@ -335,6 +369,10 @@ services:
|
||||
volumes:
|
||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./orders/alembic.ini:/app/orders/alembic.ini:ro
|
||||
- ./orders/alembic:/app/orders/alembic:ro
|
||||
- ./orders/app.py:/app/app.py
|
||||
@@ -369,6 +407,10 @@ services:
|
||||
volumes:
|
||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./test/app.py:/app/app.py
|
||||
- ./test/sx:/app/sx
|
||||
- ./test/bp:/app/bp
|
||||
@@ -393,9 +435,14 @@ services:
|
||||
- "8012:8000"
|
||||
environment:
|
||||
<<: *dev-env
|
||||
SX_STANDALONE: "true"
|
||||
volumes:
|
||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./sx/app.py:/app/app.py
|
||||
- ./sx/sxc:/app/sxc
|
||||
- ./sx/bp:/app/bp
|
||||
@@ -431,6 +478,10 @@ services:
|
||||
dockerfile: test/Dockerfile.unit
|
||||
volumes:
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./artdag/core:/app/artdag/core
|
||||
- ./artdag/l1/tests:/app/artdag/l1/tests
|
||||
- ./artdag/l1/sexp_effects:/app/artdag/l1/sexp_effects
|
||||
@@ -456,6 +507,10 @@ services:
|
||||
dockerfile: test/Dockerfile.integration
|
||||
volumes:
|
||||
- ./shared:/app/shared
|
||||
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
|
||||
- ./spec:/app/spec:ro
|
||||
- ./lib:/app/lib:ro
|
||||
- ./web:/app/web:ro
|
||||
- ./artdag:/app/artdag
|
||||
profiles:
|
||||
- test
|
||||
|
||||
@@ -58,6 +58,8 @@ x-app-env: &app-env
|
||||
EXTERNAL_INBOXES: "artdag|https://celery-artdag.rose-ash.com/inbox"
|
||||
SX_BOUNDARY_STRICT: "1"
|
||||
SX_USE_REF: "1"
|
||||
SX_USE_OCAML: "1"
|
||||
SX_OCAML_BIN: "/app/bin/sx_server"
|
||||
|
||||
services:
|
||||
blog:
|
||||
|
||||
@@ -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>')
|
||||
|
||||
|
||||
302
hosts/javascript/bootstrap.py
Normal file
302
hosts/javascript/bootstrap.py
Normal file
@@ -0,0 +1,302 @@
|
||||
#!/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)
|
||||
|
||||
import tempfile
|
||||
from shared.sx.parser import serialize
|
||||
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,
|
||||
)
|
||||
|
||||
|
||||
_bridge = None # cached OcamlSync instance
|
||||
|
||||
|
||||
def _get_bridge():
|
||||
"""Get or create the OCaml sync bridge with transpiler loaded."""
|
||||
global _bridge
|
||||
if _bridge is not None:
|
||||
return _bridge
|
||||
from shared.sx.ocaml_sync import OcamlSync
|
||||
_bridge = OcamlSync()
|
||||
_bridge.load(os.path.join(_HERE, "transpiler.sx"))
|
||||
return _bridge
|
||||
|
||||
|
||||
def load_js_sx():
|
||||
"""Load js.sx transpiler into the OCaml kernel. Returns the bridge."""
|
||||
return _get_bridge()
|
||||
|
||||
|
||||
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
|
||||
|
||||
# Source directories: core spec, standard library, web framework
|
||||
_source_dirs = [
|
||||
os.path.join(_PROJECT, "spec"), # Core language spec
|
||||
os.path.join(_PROJECT, "lib"), # Standard library (stdlib, compiler, vm, ...)
|
||||
os.path.join(_PROJECT, "web"), # Web framework
|
||||
]
|
||||
bridge = _get_bridge()
|
||||
|
||||
# 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)"),
|
||||
# stdlib.sx is loaded at runtime via eval, not transpiled —
|
||||
# transpiling it would shadow native PRIMITIVES in module scope.
|
||||
("freeze.sx", "freeze (serializable state boundaries)"),
|
||||
("content.sx", "content (content-addressed computation)"),
|
||||
("render.sx", "render (core)"),
|
||||
("web-forms.sx", "web-forms (defstyle, deftype, defeffect, defrelation)"),
|
||||
]
|
||||
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")
|
||||
# Serialize defines to SX, write to temp file, load into OCaml kernel
|
||||
defines_sx = serialize(sx_defines)
|
||||
with tempfile.NamedTemporaryFile(mode="w", suffix=".sx", delete=False) as tmp:
|
||||
tmp.write(f"(define _defines \'{defines_sx})\n")
|
||||
tmp_path = tmp.name
|
||||
try:
|
||||
bridge.load(tmp_path)
|
||||
finally:
|
||||
os.unlink(tmp_path)
|
||||
result = bridge.eval("(js-translate-file _defines)")
|
||||
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)
|
||||
|
||||
# Load stdlib.sx via eval (NOT transpiled) so defines go into the eval
|
||||
# env, not the module scope. This prevents stdlib functions from
|
||||
# shadowing native PRIMITIVES aliases used by transpiled evaluator code.
|
||||
stdlib_path = _find_sx("stdlib.sx")
|
||||
if stdlib_path:
|
||||
with open(stdlib_path) as f:
|
||||
stdlib_src = f.read()
|
||||
# Escape for JS string literal
|
||||
stdlib_escaped = stdlib_src.replace("\\", "\\\\").replace('"', '\\"').replace("\n", "\\n")
|
||||
parts.append(f'\n // === stdlib.sx (eval\'d at runtime, not transpiled) ===')
|
||||
parts.append(f' (function() {{')
|
||||
parts.append(f' var src = "{stdlib_escaped}";')
|
||||
parts.append(f' var forms = sxParse(src);')
|
||||
parts.append(f' var tmpEnv = merge({{}}, PRIMITIVES);')
|
||||
parts.append(f' for (var i = 0; i < forms.length; i++) {{')
|
||||
parts.append(f' trampoline(evalExpr(forms[i], tmpEnv));')
|
||||
parts.append(f' }}')
|
||||
parts.append(f' for (var k in tmpEnv) {{')
|
||||
parts.append(f' if (!PRIMITIVES[k]) PRIMITIVES[k] = tmpEnv[k];')
|
||||
parts.append(f' }}')
|
||||
parts.append(f' }})();\n')
|
||||
|
||||
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)
|
||||
3568
hosts/javascript/platform.py
Normal file
3568
hosts/javascript/platform.py
Normal file
File diff suppressed because it is too large
Load Diff
356
hosts/javascript/run_tests.js
Normal file
356
hosts/javascript/run_tests.js
Normal file
@@ -0,0 +1,356 @@
|
||||
#!/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
|
||||
// primitive? is now in platform.py PRIMITIVES
|
||||
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;
|
||||
};
|
||||
|
||||
// Aser test helper: parse SX source, evaluate via aser, return wire format string
|
||||
env["render-sx"] = function(source) {
|
||||
const exprs = Sx.parse(source);
|
||||
const parts = [];
|
||||
for (const expr of exprs) {
|
||||
const result = Sx.renderToSx(expr, env);
|
||||
if (result !== null && result !== undefined && result !== Sx.NIL) {
|
||||
parts.push(typeof result === "string" ? result : Sx.serialize(result));
|
||||
}
|
||||
}
|
||||
return parts.join("");
|
||||
};
|
||||
|
||||
// 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 libTests = path.join(projectDir, "lib", "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);
|
||||
}
|
||||
|
||||
// Load compiler + VM from lib/ when running full tests
|
||||
if (fullBuild) {
|
||||
const libDir = path.join(projectDir, "lib");
|
||||
for (const libFile of ["bytecode.sx", "compiler.sx", "vm.sx"]) {
|
||||
const libPath = path.join(libDir, libFile);
|
||||
if (fs.existsSync(libPath)) {
|
||||
const src = fs.readFileSync(libPath, "utf8");
|
||||
const exprs = Sx.parse(src);
|
||||
for (const expr of exprs) {
|
||||
try { Sx.eval(expr, env); } catch (e) {
|
||||
console.error(`Error loading ${libFile}: ${e.message}`);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// Determine which tests to run
|
||||
const args = process.argv.slice(2).filter(a => !a.startsWith("--"));
|
||||
let testFiles = [];
|
||||
|
||||
if (args.length > 0) {
|
||||
// Specific test files — search spec, lib, and web test dirs
|
||||
for (const arg of args) {
|
||||
const name = arg.endsWith(".sx") ? arg : `${arg}.sx`;
|
||||
const specPath = path.join(specTests, name);
|
||||
const libPath = path.join(libTests, name);
|
||||
const webPath = path.join(webTests, name);
|
||||
if (fs.existsSync(specPath)) testFiles.push(specPath);
|
||||
else if (fs.existsSync(libPath)) testFiles.push(libPath);
|
||||
else if (fs.existsSync(webPath)) testFiles.push(webPath);
|
||||
else console.error(`Test file not found: ${name}`);
|
||||
}
|
||||
} else {
|
||||
// All spec tests (core language — always run)
|
||||
for (const f of fs.readdirSync(specTests).sort()) {
|
||||
if (f.startsWith("test-") && f.endsWith(".sx") && f !== "test-framework.sx") {
|
||||
testFiles.push(path.join(specTests, f));
|
||||
}
|
||||
}
|
||||
// Library tests (only with --full — require compiler, vm, signals, etc.)
|
||||
if (fullBuild) {
|
||||
for (const f of fs.readdirSync(libTests).sort()) {
|
||||
if (f.startsWith("test-") && f.endsWith(".sx")) {
|
||||
testFiles.push(path.join(libTests, 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);
|
||||
1574
hosts/javascript/transpiler.sx
Normal file
1574
hosts/javascript/transpiler.sx
Normal file
File diff suppressed because it is too large
Load Diff
25
hosts/ocaml/Dockerfile
Normal file
25
hosts/ocaml/Dockerfile
Normal file
@@ -0,0 +1,25 @@
|
||||
# OCaml SX kernel build image.
|
||||
#
|
||||
# Produces a statically-linked sx_server binary that can be COPY'd
|
||||
# into any service's Docker image.
|
||||
#
|
||||
# Usage:
|
||||
# docker build -t sx-kernel -f hosts/ocaml/Dockerfile .
|
||||
# docker build --target=export -o hosts/ocaml/_build/export -f hosts/ocaml/Dockerfile .
|
||||
|
||||
FROM ocaml/opam:debian-12-ocaml-5.2 AS build
|
||||
|
||||
USER opam
|
||||
WORKDIR /home/opam/sx
|
||||
|
||||
# Copy only what's needed for the OCaml build
|
||||
COPY --chown=opam:opam hosts/ocaml/dune-project ./
|
||||
COPY --chown=opam:opam hosts/ocaml/lib/ ./lib/
|
||||
COPY --chown=opam:opam hosts/ocaml/bin/ ./bin/
|
||||
|
||||
# Build the server binary
|
||||
RUN eval $(opam env) && dune build bin/sx_server.exe
|
||||
|
||||
# Export stage — just the binary
|
||||
FROM scratch AS export
|
||||
COPY --from=build /home/opam/sx/_build/default/bin/sx_server.exe /sx_server
|
||||
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 integration_tests)
|
||||
(libraries sx unix))
|
||||
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))
|
||||
521
hosts/ocaml/bin/integration_tests.ml
Normal file
521
hosts/ocaml/bin/integration_tests.ml
Normal file
@@ -0,0 +1,521 @@
|
||||
(** Integration tests — exercises the full rendering pipeline.
|
||||
|
||||
Loads spec files + web adapters into a server-like env, then renders
|
||||
HTML expressions. Catches "Undefined symbol" errors that only surface
|
||||
when the full stack is loaded (not caught by spec unit tests).
|
||||
|
||||
Usage:
|
||||
dune exec bin/integration_tests.exe *)
|
||||
|
||||
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
|
||||
|
||||
let pass_count = ref 0
|
||||
let fail_count = ref 0
|
||||
|
||||
let assert_eq name expected actual =
|
||||
if expected = actual then begin
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: %s\n%!" name
|
||||
end else begin
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: %s\n expected: %s\n got: %s\n%!" name expected actual
|
||||
end
|
||||
|
||||
let assert_contains name needle haystack =
|
||||
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
|
||||
if String.length needle > 0 && find 0 then begin
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: %s\n%!" name
|
||||
end else begin
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: %s — expected to contain %S in %S\n%!" name needle haystack
|
||||
end
|
||||
|
||||
let assert_no_error name f =
|
||||
try
|
||||
ignore (f ());
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: %s\n%!" name
|
||||
with
|
||||
| Eval_error msg ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: %s — %s\n%!" name msg
|
||||
| exn ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: %s — %s\n%!" name (Printexc.to_string exn)
|
||||
|
||||
(* Build a server-like env with rendering support *)
|
||||
let make_integration_env () =
|
||||
let env = make_env () in
|
||||
let bind (n : string) fn =
|
||||
ignore (Sx_types.env_bind env n (NativeFn (n, fn)))
|
||||
in
|
||||
|
||||
Sx_render.setup_render_env env;
|
||||
|
||||
(* HTML tag functions — same as sx_server.ml *)
|
||||
List.iter (fun tag ->
|
||||
ignore (env_bind env tag
|
||||
(NativeFn ("html:" ^ tag, fun args -> List (Symbol tag :: args))))
|
||||
) Sx_render.html_tags;
|
||||
|
||||
(* Platform primitives needed by spec/render.sx and adapters *)
|
||||
bind "make-raw-html" (fun args ->
|
||||
match args with [String s] -> RawHTML s | [v] -> RawHTML (value_to_string v) | _ -> Nil);
|
||||
bind "raw-html-content" (fun args ->
|
||||
match args with [RawHTML s] -> String s | [String s] -> String s | _ -> String "");
|
||||
bind "escape-html" (fun args ->
|
||||
match args with [String s] -> String (Sx_render.escape_html s) | _ -> String "");
|
||||
bind "escape-attr" (fun args ->
|
||||
match args with [String s] -> String (Sx_render.escape_html s) | _ -> String "");
|
||||
bind "escape-string" (fun args ->
|
||||
match args with [String s] -> String (Sx_render.escape_html s) | _ -> String "");
|
||||
bind "is-html-tag?" (fun args ->
|
||||
match args with [String s] -> Bool (Sx_render.is_html_tag s) | _ -> Bool false);
|
||||
bind "is-void-element?" (fun args ->
|
||||
match args with [String s] -> Bool (Sx_render.is_void s) | _ -> Bool false);
|
||||
bind "is-boolean-attr?" (fun args ->
|
||||
match args with [String s] -> Bool (Sx_render.is_boolean_attr s) | _ -> Bool false);
|
||||
|
||||
(* Mutable operations needed by adapter code *)
|
||||
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"));
|
||||
bind "dict-set!" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k; v] -> Hashtbl.replace d k v; v
|
||||
| [Dict d; Keyword k; v] -> Hashtbl.replace d k v; v
|
||||
| _ -> Nil);
|
||||
bind "dict-has?" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k] -> Bool (Hashtbl.mem d k)
|
||||
| [Dict d; Keyword k] -> Bool (Hashtbl.mem d k)
|
||||
| _ -> Bool false);
|
||||
bind "dict-get" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k] -> (match Hashtbl.find_opt d k with Some v -> v | None -> Nil)
|
||||
| [Dict d; Keyword k] -> (match Hashtbl.find_opt d k with Some v -> v | None -> Nil)
|
||||
| _ -> Nil);
|
||||
bind "empty-dict?" (fun args ->
|
||||
match args with
|
||||
| [Dict d] -> Bool (Hashtbl.length d = 0)
|
||||
| _ -> Bool true);
|
||||
bind "mutable-list" (fun _args -> ListRef (ref []));
|
||||
|
||||
(* Symbol/keyword accessors needed by adapter-html.sx *)
|
||||
bind "symbol-name" (fun args ->
|
||||
match args with [Symbol s] -> String s | _ -> raise (Eval_error "symbol-name: expected symbol"));
|
||||
bind "keyword-name" (fun args ->
|
||||
match args with [Keyword k] -> String k | _ -> raise (Eval_error "keyword-name: expected keyword"));
|
||||
bind "make-symbol" (fun args ->
|
||||
match args with [String s] -> Symbol s | _ -> raise (Eval_error "make-symbol: expected string"));
|
||||
bind "make-keyword" (fun args ->
|
||||
match args with [String s] -> Keyword s | _ -> raise (Eval_error "make-keyword: expected string"));
|
||||
|
||||
(* Type predicates needed by adapters *)
|
||||
bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false);
|
||||
bind "component?" (fun args -> match args with [Component _] -> Bool true | _ -> Bool false);
|
||||
bind "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false);
|
||||
bind "lambda?" (fun args -> match args with [Lambda _] -> Bool true | _ -> Bool false);
|
||||
bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
|
||||
bind "spread-attrs" (fun args ->
|
||||
match args with
|
||||
| [Spread pairs] -> let d = Hashtbl.create 8 in
|
||||
List.iter (fun (k, v) -> Hashtbl.replace d k v) pairs; Dict d
|
||||
| _ -> Nil);
|
||||
bind "component-name" (fun args -> match args with [Component c] -> String c.c_name | [Island i] -> String i.i_name | _ -> Nil);
|
||||
bind "component-params" (fun args -> match args with [Component c] -> List (List.map (fun s -> String s) c.c_params) | _ -> List []);
|
||||
bind "component-body" (fun args -> match args with [Component c] -> c.c_body | _ -> Nil);
|
||||
bind "component-closure" (fun args -> match args with [Component c] -> Env c.c_closure | _ -> 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 "lambda-params" (fun args -> match args with [Lambda l] -> List (List.map (fun s -> String s) l.l_params) | _ -> List []);
|
||||
bind "lambda-body" (fun args -> match args with [Lambda l] -> l.l_body | _ -> Nil);
|
||||
bind "lambda-closure" (fun args -> match args with [Lambda l] -> Env l.l_closure | _ -> Nil);
|
||||
bind "lambda-name" (fun args -> match args with [Lambda l] -> (match l.l_name with Some n -> String n | None -> Nil) | _ -> Nil);
|
||||
bind "set-lambda-name!" (fun args -> match args with [Lambda l; String n] -> l.l_name <- Some n; Nil | _ -> Nil);
|
||||
|
||||
(* Environment operations *)
|
||||
bind "env-extend" (fun args ->
|
||||
match args with [Env e] -> Env (env_extend e) | _ -> Env (env_extend env));
|
||||
bind "env-bind!" (fun args ->
|
||||
match args with [Env e; String k; v] -> env_bind e k v | _ -> Nil);
|
||||
bind "env-set!" (fun args ->
|
||||
match args with [Env e; String k; v] -> env_set e k v | _ -> Nil);
|
||||
bind "env-get" (fun args ->
|
||||
match args with [Env e; String k] -> env_get e k | _ -> Nil);
|
||||
bind "env-has?" (fun args ->
|
||||
match args with [Env e; String k] -> Bool (env_has e k) | _ -> Bool false);
|
||||
bind "env-merge" (fun args ->
|
||||
match args with [Env a; Env b] -> Env (env_merge a b) | _ -> Nil);
|
||||
bind "make-env" (fun _args -> Env (make_env ()));
|
||||
|
||||
(* Eval/trampoline — needed by adapters *)
|
||||
bind "eval-expr" (fun args ->
|
||||
match args with
|
||||
| [expr; e] -> Sx_ref.eval_expr expr e
|
||||
| _ -> Nil);
|
||||
bind "trampoline" (fun args ->
|
||||
match args with
|
||||
| [Thunk (e, env)] -> Sx_ref.eval_expr e (Env env)
|
||||
| [v] -> v | _ -> Nil);
|
||||
bind "call-lambda" (fun args ->
|
||||
match args with
|
||||
| [f; List a] -> Sx_runtime.sx_call f a
|
||||
| [f; a] -> Sx_runtime.sx_call f [a]
|
||||
| _ -> Nil);
|
||||
bind "expand-macro" (fun args ->
|
||||
match args with
|
||||
| [Macro m; List macro_args; _env] ->
|
||||
let local = env_extend m.m_closure 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
|
||||
| _ :: _, [] -> ()
|
||||
in
|
||||
bind_params m.m_params macro_args;
|
||||
Sx_ref.eval_expr m.m_body (Env local)
|
||||
| _ -> Nil);
|
||||
|
||||
(* Scope/provide — needed by adapter-html.sx and the CEK evaluator.
|
||||
Must be registered as primitives (prim_call) not just env bindings. *)
|
||||
let scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8 in
|
||||
let scope_emitted : (string, value list) Hashtbl.t = Hashtbl.create 8 in
|
||||
let scope_push name v =
|
||||
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
|
||||
Hashtbl.replace scope_stacks name (v :: stack); Nil in
|
||||
let scope_pop name =
|
||||
(match Hashtbl.find_opt scope_stacks name with
|
||||
| Some (_ :: rest) -> Hashtbl.replace scope_stacks name rest
|
||||
| _ -> ()); Nil in
|
||||
let scope_peek name =
|
||||
match Hashtbl.find_opt scope_stacks name with
|
||||
| Some (v :: _) -> v | _ -> Nil in
|
||||
let scope_emit name v =
|
||||
let items = try Hashtbl.find scope_emitted name with Not_found -> [] in
|
||||
Hashtbl.replace scope_emitted name (items @ [v]); Nil in
|
||||
let emitted name =
|
||||
match Hashtbl.find_opt scope_emitted name with Some l -> List l | None -> List [] in
|
||||
(* Register as both env bindings AND primitives *)
|
||||
bind "scope-push!" (fun args -> match args with [String n; v] -> scope_push n v | _ -> Nil);
|
||||
bind "scope-pop!" (fun args -> match args with [String n] -> scope_pop n | _ -> Nil);
|
||||
bind "scope-peek" (fun args -> match args with [String n] -> scope_peek n | _ -> Nil);
|
||||
bind "scope-emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil);
|
||||
bind "emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []);
|
||||
bind "emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil);
|
||||
bind "scope-emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []);
|
||||
bind "collect!" (fun _args -> Nil);
|
||||
bind "collected" (fun _args -> List []);
|
||||
bind "clear-collected!" (fun _args -> Nil);
|
||||
bind "scope-collected" (fun _args -> List []);
|
||||
bind "scope-clear-collected!" (fun _args -> Nil);
|
||||
bind "provide-push!" (fun args -> match args with [String n; v] -> scope_push n v | _ -> Nil);
|
||||
bind "provide-pop!" (fun args -> match args with [String n] -> scope_pop n | _ -> Nil);
|
||||
bind "context" (fun args -> match args with [String n] -> scope_peek n | [String n; _] -> scope_peek n | _ -> Nil);
|
||||
bind "sx-context" (fun args -> match args with [String n] -> scope_peek n | [String n; _] -> scope_peek n | _ -> Nil);
|
||||
(* Also register as primitives for prim_call *)
|
||||
Sx_primitives.register "scope-push!" (fun args -> match args with [String n; v] -> scope_push n v | _ -> Nil);
|
||||
Sx_primitives.register "scope-pop!" (fun args -> match args with [String n] -> scope_pop n | _ -> Nil);
|
||||
Sx_primitives.register "scope-peek" (fun args -> match args with [String n] -> scope_peek n | _ -> Nil);
|
||||
Sx_primitives.register "scope-emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil);
|
||||
Sx_primitives.register "emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []);
|
||||
Sx_primitives.register "emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil);
|
||||
Sx_primitives.register "scope-emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []);
|
||||
Sx_primitives.register "collect!" (fun _args -> Nil);
|
||||
Sx_primitives.register "collected" (fun _args -> List []);
|
||||
Sx_primitives.register "clear-collected!" (fun _args -> Nil);
|
||||
Sx_primitives.register "scope-collected" (fun _args -> List []);
|
||||
Sx_primitives.register "scope-clear-collected!" (fun _args -> Nil);
|
||||
Sx_primitives.register "provide-push!" (fun args -> match args with [String n; v] -> scope_push n v | _ -> Nil);
|
||||
Sx_primitives.register "provide-pop!" (fun args -> match args with [String n] -> scope_pop n | _ -> Nil);
|
||||
Sx_primitives.register "context" (fun args -> match args with [String n] -> scope_peek n | [String n; _] -> scope_peek n | _ -> Nil);
|
||||
|
||||
(* Render-mode flags *)
|
||||
ignore (env_bind env "*render-active*" (Bool false));
|
||||
bind "set-render-active!" (fun args ->
|
||||
match args with [v] -> ignore (env_set env "*render-active*" v); Nil | _ -> Nil);
|
||||
bind "render-active?" (fun _args ->
|
||||
try env_get env "*render-active*" with _ -> Bool false);
|
||||
bind "definition-form?" (fun args ->
|
||||
match args with
|
||||
| [String s] -> Bool (List.mem s ["define"; "defcomp"; "defisland"; "defmacro";
|
||||
"defstyle"; "defhandler"; "deftype"; "defeffect"; "defquery"; "defaction"; "defrelation"])
|
||||
| _ -> Bool false);
|
||||
|
||||
(* Signal stubs for SSR — overridden when signals.sx is loaded *)
|
||||
bind "signal" (fun args -> match args with [v] -> v | _ -> Nil);
|
||||
bind "computed" (fun args -> match args with [f] -> Sx_runtime.sx_call f [] | _ -> Nil);
|
||||
bind "deref" (fun args -> match args with [v] -> v | _ -> Nil);
|
||||
bind "reset!" (fun _args -> Nil);
|
||||
bind "swap!" (fun _args -> Nil);
|
||||
bind "effect" (fun _args -> Nil);
|
||||
bind "batch" (fun _args -> Nil);
|
||||
|
||||
(* Type predicates — needed by adapter-sx.sx *)
|
||||
bind "callable?" (fun args ->
|
||||
match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false);
|
||||
bind "lambda?" (fun args -> match args with [Lambda _] -> Bool true | _ -> Bool false);
|
||||
bind "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false);
|
||||
bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false);
|
||||
bind "component?" (fun args ->
|
||||
match args with [Component _] | [Island _] -> Bool true | _ -> Bool false);
|
||||
bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
|
||||
bind "lambda-params" (fun args ->
|
||||
match args with [Lambda l] -> List (List.map (fun s -> String s) l.l_params) | _ -> List []);
|
||||
bind "lambda-body" (fun args -> match args with [Lambda l] -> l.l_body | _ -> Nil);
|
||||
bind "lambda-closure" (fun args ->
|
||||
match args with [Lambda l] -> Env l.l_closure | _ -> Dict (Hashtbl.create 0));
|
||||
bind "component-name" (fun args ->
|
||||
match args with [Component c] -> String c.c_name | [Island i] -> String i.i_name | _ -> String "");
|
||||
bind "component-closure" (fun args ->
|
||||
match args with [Component c] -> Env c.c_closure | [Island i] -> Env i.i_closure | _ -> Dict (Hashtbl.create 0));
|
||||
bind "component-params" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> List (List.map (fun s -> String s) c.c_params)
|
||||
| [Island i] -> List (List.map (fun s -> String s) i.i_params)
|
||||
| _ -> Nil);
|
||||
bind "component-body" (fun args ->
|
||||
match args with [Component c] -> c.c_body | [Island i] -> i.i_body | _ -> Nil);
|
||||
bind "component-affinity" (fun args ->
|
||||
match args with [Component c] -> String c.c_affinity
|
||||
| [Island _] -> Nil | _ -> Nil);
|
||||
bind "component-has-children?" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> Bool (List.mem "children" c.c_params)
|
||||
| [Island i] -> Bool (List.mem "children" i.i_params)
|
||||
| _ -> Bool false);
|
||||
|
||||
(* Evaluator bridge — needed by adapter-sx.sx *)
|
||||
bind "call-lambda" (fun args ->
|
||||
match args with
|
||||
| [fn_val; List call_args; Env _e] ->
|
||||
Sx_ref.cek_call fn_val (List call_args)
|
||||
| [fn_val; List call_args] ->
|
||||
Sx_ref.cek_call fn_val (List call_args)
|
||||
| _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));
|
||||
bind "cek-call" (fun args ->
|
||||
match args with
|
||||
| [fn_val; List call_args] -> Sx_ref.cek_call fn_val (List call_args)
|
||||
| [fn_val; Nil] -> Sx_ref.cek_call fn_val (List [])
|
||||
| [fn_val] -> Sx_ref.cek_call fn_val (List [])
|
||||
| _ -> Nil);
|
||||
bind "expand-macro" (fun args ->
|
||||
match args with
|
||||
| [Macro m; List macro_args; Env e] ->
|
||||
let body_env = { bindings = Hashtbl.create 16; parent = Some e } in
|
||||
List.iteri (fun i p ->
|
||||
let v = if i < List.length macro_args then List.nth macro_args i else Nil in
|
||||
Hashtbl.replace body_env.bindings p v
|
||||
) m.m_params;
|
||||
Sx_ref.eval_expr m.m_body (Env body_env)
|
||||
| _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
|
||||
bind "eval-expr" (fun args ->
|
||||
match args with
|
||||
| [expr; e] -> Sx_ref.eval_expr expr (Env (Sx_runtime.unwrap_env e))
|
||||
| [expr] -> Sx_ref.eval_expr expr (Env env)
|
||||
| _ -> raise (Eval_error "eval-expr: expected (expr env?)"));
|
||||
bind "trampoline" (fun args ->
|
||||
match args with
|
||||
| [v] ->
|
||||
let rec resolve v = match v with
|
||||
| Thunk (body, closure_env) -> resolve (Sx_ref.eval_expr body (Env closure_env))
|
||||
| _ -> v
|
||||
in resolve v
|
||||
| _ -> raise (Eval_error "trampoline: expected 1 arg"));
|
||||
bind "expand-components?" (fun _args -> Bool false);
|
||||
bind "register-special-form!" (fun args ->
|
||||
match args with
|
||||
| [String name; handler] ->
|
||||
ignore (Sx_ref.register_special_form (String name) handler); Nil
|
||||
| _ -> raise (Eval_error "register-special-form!: expected (name handler)"));
|
||||
ignore (env_bind env "*custom-special-forms*" Sx_ref.custom_special_forms);
|
||||
|
||||
(* DOM stubs *)
|
||||
bind "create-text-node" (fun args -> match args with [String s] -> String s | _ -> Nil);
|
||||
bind "create-fragment" (fun _args -> Nil);
|
||||
bind "dom-create-element" (fun _args -> Nil);
|
||||
bind "dom-append" (fun _args -> Nil);
|
||||
bind "dom-set-attr" (fun _args -> Nil);
|
||||
bind "dom-set-prop" (fun _args -> Nil);
|
||||
bind "dom-get-attr" (fun _args -> Nil);
|
||||
bind "dom-query" (fun _args -> Nil);
|
||||
bind "dom-body" (fun _args -> Nil);
|
||||
|
||||
(* Misc stubs *)
|
||||
bind "random-int" (fun args ->
|
||||
match args with
|
||||
| [Number lo; Number hi] -> Number (lo +. Float.round (Random.float (hi -. lo)))
|
||||
| _ -> Number 0.0);
|
||||
bind "expand-components?" (fun _args -> Bool false);
|
||||
bind "freeze-scope" (fun _args -> Nil);
|
||||
bind "freeze-signal" (fun _args -> Nil);
|
||||
bind "thaw-from-sx" (fun _args -> Nil);
|
||||
bind "local-storage-get" (fun _args -> Nil);
|
||||
bind "local-storage-set" (fun _args -> Nil);
|
||||
bind "schedule-idle" (fun _args -> Nil);
|
||||
bind "run-post-render-hooks" (fun _args -> Nil);
|
||||
bind "freeze-to-sx" (fun _args -> String "");
|
||||
|
||||
env
|
||||
|
||||
|
||||
let () =
|
||||
Printexc.record_backtrace true;
|
||||
|
||||
(* Find project root *)
|
||||
let rec find_root dir =
|
||||
let candidate = Filename.concat dir "spec/render.sx" in
|
||||
if Sys.file_exists candidate then dir
|
||||
else let parent = Filename.dirname dir in
|
||||
if parent = dir then Sys.getcwd () else find_root parent
|
||||
in
|
||||
let root = find_root (Sys.getcwd ()) in
|
||||
let spec p = Filename.concat (Filename.concat root "spec") p in
|
||||
let lib p = Filename.concat (Filename.concat root "lib") p in
|
||||
let web p = Filename.concat (Filename.concat root "web") p in
|
||||
|
||||
let env = make_integration_env () in
|
||||
|
||||
(* Load spec + lib + adapters *)
|
||||
Printf.printf "Loading spec + lib + adapters...\n%!";
|
||||
let load path =
|
||||
if Sys.file_exists path then begin
|
||||
let exprs = Sx_parser.parse_file path in
|
||||
List.iter (fun expr -> ignore (Sx_ref.eval_expr expr (Env env))) exprs;
|
||||
Printf.printf " loaded %s (%d defs)\n%!" (Filename.basename path) (List.length exprs)
|
||||
end else
|
||||
Printf.printf " SKIP %s (not found)\n%!" path
|
||||
in
|
||||
load (spec "parser.sx");
|
||||
load (spec "render.sx");
|
||||
load (web "signals.sx");
|
||||
load (web "adapter-html.sx");
|
||||
load (web "adapter-sx.sx");
|
||||
ignore lib; (* available for future library loading *)
|
||||
|
||||
(* Helper: render SX source string to HTML *)
|
||||
let render_html src =
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let expr = match exprs with [e] -> e | _ -> Nil in
|
||||
Sx_render.render_to_html expr env
|
||||
in
|
||||
|
||||
(* Helper: call SX render-to-html via the adapter *)
|
||||
let sx_render_html src =
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let expr = match exprs with [e] -> e | _ -> Nil in
|
||||
let call = List [Symbol "render-to-html"; List [Symbol "quote"; expr]; Env env] in
|
||||
match Sx_ref.eval_expr call (Env env) with
|
||||
| String s | RawHTML s -> s
|
||||
| v -> value_to_string v
|
||||
in
|
||||
|
||||
(* ================================================================== *)
|
||||
Printf.printf "\nSuite: native renderer — HTML tags\n%!";
|
||||
assert_eq "div" "<div>hello</div>" (render_html "(div \"hello\")");
|
||||
assert_eq "div with class" "<div class=\"card\">text</div>" (render_html "(div :class \"card\" \"text\")");
|
||||
assert_eq "nested tags" "<div><p>inner</p></div>" (render_html "(div (p \"inner\"))");
|
||||
assert_eq "void element" "<br />" (render_html "(br)");
|
||||
assert_eq "h1" "<h1>Title</h1>" (render_html "(h1 \"Title\")");
|
||||
assert_eq "span with attrs" "<span class=\"bold\">text</span>" (render_html "(span :class \"bold\" \"text\")");
|
||||
|
||||
(* ================================================================== *)
|
||||
Printf.printf "\nSuite: SX adapter render-to-html — HTML tags\n%!";
|
||||
assert_no_error "div doesn't throw" (fun () -> sx_render_html "(div \"hello\")");
|
||||
assert_contains "div produces tag" "<div" (sx_render_html "(div \"hello\")");
|
||||
assert_contains "div with class" "class=\"card\"" (sx_render_html "(div :class \"card\" \"text\")");
|
||||
assert_contains "nested tags" "<p>" (sx_render_html "(div (p \"inner\"))");
|
||||
assert_no_error "h1 doesn't throw" (fun () -> sx_render_html "(h1 \"Title\")");
|
||||
assert_no_error "span doesn't throw" (fun () -> sx_render_html "(span :class \"bold\" \"text\")");
|
||||
assert_no_error "table doesn't throw" (fun () -> sx_render_html "(table (tr (td \"cell\")))");
|
||||
|
||||
(* ================================================================== *)
|
||||
Printf.printf "\nSuite: SX adapter — special forms in HTML context\n%!";
|
||||
assert_contains "when true renders" "<p>" (sx_render_html "(when true (p \"yes\"))");
|
||||
assert_eq "when false empty" "" (sx_render_html "(when false (p \"no\"))");
|
||||
assert_contains "if true branch" "yes" (sx_render_html "(if true (span \"yes\") (span \"no\"))");
|
||||
assert_contains "if false branch" "no" (sx_render_html "(if false (span \"yes\") (span \"no\"))");
|
||||
assert_contains "let in render" "hello" (sx_render_html "(let ((x \"hello\")) (p x))");
|
||||
|
||||
(* ================================================================== *)
|
||||
Printf.printf "\nSuite: SX adapter — letrec in HTML context\n%!";
|
||||
assert_no_error "letrec with div body" (fun () ->
|
||||
sx_render_html "(letrec ((x 42)) (div (str x)))");
|
||||
assert_contains "letrec renders body" "<div>" (sx_render_html "(letrec ((x 42)) (div (str x)))");
|
||||
assert_no_error "letrec with side effects then div" (fun () ->
|
||||
sx_render_html "(letrec ((x 1) (y 2)) (let ((z (+ x y))) (div (str z))))");
|
||||
|
||||
(* ================================================================== *)
|
||||
Printf.printf "\nSuite: SX adapter — components\n%!";
|
||||
(try
|
||||
assert_no_error "defcomp + render" (fun () ->
|
||||
ignore (Sx_ref.eval_expr
|
||||
(List.hd (Sx_parser.parse_all "(defcomp ~test-card (&key title &rest children) (div :class \"card\" (h2 title) children))"))
|
||||
(Env env));
|
||||
sx_render_html "(~test-card :title \"Hi\" (p \"body\"))");
|
||||
assert_contains "component renders div" "<div" (sx_render_html "(~test-card :title \"Hi\" (p \"body\"))");
|
||||
assert_contains "component renders title" "Hi" (sx_render_html "(~test-card :title \"Hi\" (p \"body\"))")
|
||||
with Eval_error msg -> incr fail_count; Printf.printf " FAIL: components — %s\n%!" msg);
|
||||
|
||||
(* ================================================================== *)
|
||||
Printf.printf "\nSuite: eval-expr with HTML tag functions\n%!";
|
||||
assert_no_error "eval (div) returns list" (fun () ->
|
||||
Sx_ref.eval_expr (List [Symbol "div"; Keyword "class"; String "foo"; String "hi"]) (Env env));
|
||||
assert_no_error "eval (span) returns list" (fun () ->
|
||||
Sx_ref.eval_expr (List [Symbol "span"; String "text"]) (Env env));
|
||||
|
||||
(* ================================================================== *)
|
||||
(* Regression: call-lambda re-evaluated Dict args through eval_expr,
|
||||
which copies dicts. Mutations inside the lambda (e.g. signal
|
||||
reset!) operated on the copy, not the original. This broke
|
||||
island SSR where aser processes multi-body let forms. *)
|
||||
Printf.printf "\nSuite: call-lambda dict identity (aser mode)\n%!";
|
||||
let aser_eval src =
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let expr = match exprs with [e] -> e | _ -> Nil in
|
||||
let call = List [Symbol "aser"; List [Symbol "quote"; expr]; Env env] in
|
||||
match Sx_ref.eval_expr call (Env env) with
|
||||
| String s | SxExpr s -> s
|
||||
| v -> value_to_string v
|
||||
in
|
||||
assert_eq "lambda dict mutation in aser multi-body let"
|
||||
"99"
|
||||
(aser_eval
|
||||
"(let ((mutate! (fn (d k v) (dict-set! d k v)))
|
||||
(d (dict \"x\" 1)))
|
||||
(mutate! d \"x\" 99)
|
||||
(get d \"x\"))");
|
||||
assert_eq "signal reset! in aser multi-body let"
|
||||
"99"
|
||||
(aser_eval
|
||||
"(let ((s (signal 42)))
|
||||
(reset! s 99)
|
||||
(deref s))");
|
||||
assert_eq "signal reset! then len of deref"
|
||||
"3"
|
||||
(aser_eval
|
||||
"(let ((s (signal (list))))
|
||||
(reset! s (list 1 2 3))
|
||||
(len (deref s)))");
|
||||
|
||||
(* ================================================================== *)
|
||||
Printf.printf "\n";
|
||||
Printf.printf "============================================================\n";
|
||||
Printf.printf "Integration: %d passed, %d failed\n" !pass_count !fail_count;
|
||||
Printf.printf "============================================================\n";
|
||||
if !fail_count > 0 then exit 1
|
||||
830
hosts/ocaml/bin/run_tests.ml
Normal file
830
hosts/ocaml/bin/run_tests.ml
Normal file
@@ -0,0 +1,830 @@
|
||||
(** 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 --- *)
|
||||
|
||||
(* Env operations — accept both Env and Dict *)
|
||||
let uw = Sx_runtime.unwrap_env in
|
||||
bind "env-get" (fun args ->
|
||||
match args with
|
||||
| [e; String k] -> Sx_types.env_get (uw e) k
|
||||
| [e; Keyword k] -> Sx_types.env_get (uw e) k
|
||||
| _ -> raise (Eval_error "env-get: expected env and string"));
|
||||
|
||||
bind "env-has?" (fun args ->
|
||||
match args with
|
||||
| [e; String k] -> Bool (Sx_types.env_has (uw e) k)
|
||||
| [e; Keyword k] -> Bool (Sx_types.env_has (uw e) k)
|
||||
| _ -> raise (Eval_error "env-has?: expected env and string"));
|
||||
|
||||
bind "env-bind!" (fun args ->
|
||||
match args with
|
||||
| [e; String k; v] ->
|
||||
let ue = uw e in
|
||||
if k = "x" || k = "children" || k = "i" then
|
||||
Printf.eprintf "[env-bind!] '%s' env-id=%d bindings-before=%d\n%!" k (Obj.obj (Obj.repr ue) : int) (Hashtbl.length ue.Sx_types.bindings);
|
||||
Sx_types.env_bind ue k v
|
||||
| [e; Keyword k; v] -> Sx_types.env_bind (uw e) k v
|
||||
| _ -> raise (Eval_error "env-bind!: expected env, key, value"));
|
||||
|
||||
bind "env-set!" (fun args ->
|
||||
match args with
|
||||
| [e; String k; v] -> Sx_types.env_set (uw e) k v
|
||||
| [e; Keyword k; v] -> Sx_types.env_set (uw e) k v
|
||||
| _ -> raise (Eval_error "env-set!: expected env, key, value"));
|
||||
|
||||
bind "env-extend" (fun args ->
|
||||
match args with
|
||||
| [e] -> Env (Sx_types.env_extend (uw e))
|
||||
| _ -> raise (Eval_error "env-extend: expected env"));
|
||||
|
||||
bind "env-merge" (fun args ->
|
||||
match args with
|
||||
| [a; b] -> Sx_runtime.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;
|
||||
|
||||
(* Stubs needed by adapter-html.sx when loaded at test time *)
|
||||
bind "set-render-active!" (fun _args -> Nil);
|
||||
bind "render-active?" (fun _args -> Bool true);
|
||||
bind "trampoline" (fun args ->
|
||||
match args with
|
||||
| [Thunk (expr, e)] -> eval_expr expr (Env e)
|
||||
| [v] -> v
|
||||
| _ -> Nil);
|
||||
bind "eval-expr" (fun args ->
|
||||
match args with
|
||||
| [expr; e] ->
|
||||
let ue = Sx_runtime.unwrap_env e in
|
||||
eval_expr expr (Env ue)
|
||||
| [expr] -> eval_expr expr (Env env)
|
||||
| _ -> raise (Eval_error "eval-expr: expected (expr env)"));
|
||||
(* Scope primitives — use a local scope stacks table.
|
||||
Must match the same pattern as sx_server.ml's _scope_stacks. *)
|
||||
let _scope_stacks : (string, Sx_types.value list) Hashtbl.t = Hashtbl.create 8 in
|
||||
bind "scope-push!" (fun args ->
|
||||
match args with
|
||||
| [String name; value] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
Hashtbl.replace _scope_stacks name (value :: stack); Nil
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
Hashtbl.replace _scope_stacks name (Nil :: stack); Nil
|
||||
| _ -> Nil);
|
||||
bind "scope-pop!" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
|
||||
| _ -> Nil);
|
||||
bind "scope-emit!" (fun args ->
|
||||
match args with
|
||||
| [String name; value] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with
|
||||
| List items :: rest ->
|
||||
Hashtbl.replace _scope_stacks name (List (items @ [value]) :: rest)
|
||||
| _ :: rest ->
|
||||
Hashtbl.replace _scope_stacks name (List [value] :: rest)
|
||||
| [] ->
|
||||
Hashtbl.replace _scope_stacks name [List [value]]);
|
||||
Nil
|
||||
| _ -> Nil);
|
||||
bind "emitted" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with List items :: _ -> List items | _ -> List [])
|
||||
| _ -> List []);
|
||||
bind "scope-emitted" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with List items :: _ -> List items | _ -> List [])
|
||||
| _ -> List []);
|
||||
bind "provide-push!" (fun args ->
|
||||
match args with
|
||||
| [String name; value] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
Hashtbl.replace _scope_stacks name (value :: stack); Nil
|
||||
| _ -> Nil);
|
||||
bind "provide-pop!" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
|
||||
| _ -> Nil);
|
||||
bind "cond-scheme?" (fun args ->
|
||||
match args with
|
||||
| [(List clauses | ListRef { contents = clauses })] ->
|
||||
(match clauses with
|
||||
| (List _ | ListRef _) :: _ -> Bool true
|
||||
| _ -> Bool false)
|
||||
| _ -> Bool false);
|
||||
bind "expand-macro" (fun args ->
|
||||
match args with
|
||||
| [Macro m; (List a | ListRef { contents = a }); _] ->
|
||||
let local = Sx_types.env_extend m.m_closure in
|
||||
List.iteri (fun i p ->
|
||||
ignore (Sx_types.env_bind local p (if i < List.length a then List.nth a i else Nil))
|
||||
) m.m_params;
|
||||
eval_expr m.m_body (Env local)
|
||||
| _ -> raise (Eval_error "expand-macro: expected (macro args 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)
|
||||
| [Island i] -> List (List.map (fun s -> String s) i.i_params)
|
||||
| _ -> Nil);
|
||||
|
||||
bind "component-body" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> c.c_body
|
||||
| [Island i] -> i.i_body
|
||||
| _ -> Nil);
|
||||
|
||||
bind "component-has-children" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> Bool c.c_has_children
|
||||
| [Island i] -> Bool i.i_has_children
|
||||
| _ -> Bool false);
|
||||
|
||||
bind "component-affinity" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> String c.c_affinity
|
||||
| [Island _] -> String "client"
|
||||
| _ -> 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; l_compiled = 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;
|
||||
|
||||
(* Load modules needed by tests *)
|
||||
let spec_dir = Filename.concat project_dir "spec" in
|
||||
let lib_dir = Filename.concat project_dir "lib" in
|
||||
let web_dir = Filename.concat project_dir "web" in
|
||||
let load_module name dir =
|
||||
let path = Filename.concat dir name in
|
||||
if Sys.file_exists path then begin
|
||||
Printf.printf "Loading %s...\n%!" name;
|
||||
(try load_and_eval path
|
||||
with e -> Printf.eprintf "Warning: %s: %s\n%!" name (Printexc.to_string e))
|
||||
end
|
||||
in
|
||||
(* Render adapter for test-render-html.sx *)
|
||||
load_module "render.sx" spec_dir;
|
||||
load_module "adapter-html.sx" web_dir;
|
||||
(* Library modules for lib/tests/ *)
|
||||
load_module "bytecode.sx" lib_dir;
|
||||
load_module "compiler.sx" lib_dir;
|
||||
load_module "vm.sx" lib_dir;
|
||||
load_module "signals.sx" web_dir;
|
||||
load_module "freeze.sx" lib_dir;
|
||||
load_module "content.sx" lib_dir;
|
||||
load_module "types.sx" lib_dir;
|
||||
|
||||
(* Determine test files — scan spec/tests/ and lib/tests/ *)
|
||||
let lib_tests_dir = Filename.concat project_dir "lib/tests" in
|
||||
let files = if test_files = [] then begin
|
||||
(* Spec tests (core language — always run) *)
|
||||
let spec_entries = Sys.readdir spec_tests_dir in
|
||||
Array.sort String.compare spec_entries;
|
||||
let spec_files = Array.to_list spec_entries
|
||||
|> List.filter (fun f ->
|
||||
String.length f > 5 &&
|
||||
String.sub f 0 5 = "test-" &&
|
||||
Filename.check_suffix f ".sx" &&
|
||||
f <> "test-framework.sx")
|
||||
|> List.map (fun f -> Filename.concat spec_tests_dir f)
|
||||
in
|
||||
spec_files
|
||||
end else
|
||||
(* Specific test files — search all test dirs *)
|
||||
List.map (fun name ->
|
||||
let name = if Filename.check_suffix name ".sx" then name else name ^ ".sx" in
|
||||
let spec_path = Filename.concat spec_tests_dir name in
|
||||
let lib_path = Filename.concat lib_tests_dir name in
|
||||
if Sys.file_exists spec_path then spec_path
|
||||
else if Sys.file_exists lib_path then lib_path
|
||||
else Filename.concat spec_tests_dir name (* will fail with "not found" *)
|
||||
) test_files
|
||||
in
|
||||
|
||||
List.iter (fun path ->
|
||||
if Sys.file_exists path then begin
|
||||
let name = Filename.basename path in
|
||||
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
|
||||
1355
hosts/ocaml/bin/sx_server.ml
Normal file
1355
hosts/ocaml/bin/sx_server.ml
Normal file
File diff suppressed because it is too large
Load Diff
276
hosts/ocaml/bootstrap.py
Normal file
276
hosts/ocaml/bootstrap.py
Normal file
@@ -0,0 +1,276 @@
|
||||
#!/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 — forward ref, resolved after eval_expr is defined. *)
|
||||
let trampoline_fn : (value -> value) ref = ref (fun v -> v)
|
||||
let trampoline v = !trampoline_fn v
|
||||
|
||||
|
||||
|
||||
(* === Mutable state for strict mode === *)
|
||||
(* These are defined as top-level refs because the transpiler cannot handle
|
||||
global set! mutation (it creates local refs that shadow the global). *)
|
||||
let _strict_ref = ref (Bool false)
|
||||
let _prim_param_types_ref = ref Nil
|
||||
|
||||
(* JIT call hook — cek_call checks this before CEK dispatch for named
|
||||
lambdas. Registered by sx_server.ml after compiler loads. Tests
|
||||
run with hook = None (pure CEK, no compilation dependency). *)
|
||||
let jit_call_hook : (value -> value list -> value option) option ref = ref None
|
||||
|
||||
"""
|
||||
|
||||
|
||||
# OCaml fixups — wire up trampoline + iterative CEK run + JIT hook
|
||||
FIXUPS = """\
|
||||
|
||||
(* Wire up trampoline to resolve thunks via the CEK machine *)
|
||||
let () = trampoline_fn := (fun v ->
|
||||
match v with
|
||||
| Thunk (expr, env) -> eval_expr expr (Env env)
|
||||
| _ -> v)
|
||||
|
||||
(* Wire up the primitives trampoline so call_any in HO forms resolves Thunks *)
|
||||
let () = Sx_primitives._sx_trampoline_fn := !trampoline_fn
|
||||
|
||||
(* 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."""
|
||||
import tempfile
|
||||
from shared.sx.ocaml_sync import OcamlSync
|
||||
from shared.sx.parser import serialize
|
||||
|
||||
if spec_dir is None:
|
||||
spec_dir = os.path.join(_PROJECT, "spec")
|
||||
|
||||
# Load the transpiler into OCaml kernel
|
||||
bridge = OcamlSync()
|
||||
transpiler_path = os.path.join(_HERE, "transpiler.sx")
|
||||
bridge.load(transpiler_path)
|
||||
|
||||
# Spec files to transpile (in dependency order)
|
||||
# stdlib.sx functions are already registered as OCaml primitives —
|
||||
# only the evaluator needs transpilation.
|
||||
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, fixups, or already-registered primitives
|
||||
# Skip: preamble-provided, math primitives, and stdlib functions
|
||||
# that use loop/named-let (transpiler can't handle those yet)
|
||||
skip = {"trampoline", "ceil", "floor", "round", "abs", "min", "max",
|
||||
"debug-log", "debug_log", "range", "chunk-every", "zip-pairs",
|
||||
"string-contains?", "starts-with?", "ends-with?",
|
||||
"string-replace", "trim", "split", "index-of",
|
||||
"pad-left", "pad-right", "char-at", "substring"}
|
||||
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 and known names for the transpiler
|
||||
defines_list = [[name, expr] for name, expr in defines]
|
||||
known_names = [name for name, _ in defines]
|
||||
|
||||
# Serialize defines + known names to temp file, load into kernel
|
||||
defines_sx = serialize(defines_list)
|
||||
known_sx = serialize(known_names)
|
||||
with tempfile.NamedTemporaryFile(mode="w", suffix=".sx", delete=False) as tmp:
|
||||
tmp.write(f"(define _defines \'{defines_sx})\n")
|
||||
tmp.write(f"(define _known_defines \'{known_sx})\n")
|
||||
tmp_path = tmp.name
|
||||
try:
|
||||
bridge.load(tmp_path)
|
||||
finally:
|
||||
os.unlink(tmp_path)
|
||||
|
||||
# Call ml-translate-file — emits as single let rec block
|
||||
result = bridge.eval("(ml-translate-file _defines)")
|
||||
|
||||
parts.append(f"\n(* === Transpiled from {label} === *)\n")
|
||||
parts.append(result)
|
||||
|
||||
bridge.stop()
|
||||
parts.append(FIXUPS)
|
||||
output = "\n".join(parts)
|
||||
|
||||
# Post-process: fix mutable globals that the transpiler can't handle.
|
||||
# The transpiler emits local refs for set! targets within functions,
|
||||
# but top-level globals (*strict*, *prim-param-types*) need to use
|
||||
# the pre-declared refs from the preamble.
|
||||
import re
|
||||
|
||||
# Fix *strict*: use _strict_ref instead of immutable let rec binding
|
||||
output = re.sub(
|
||||
r'and _strict_ =\n \(Bool false\)',
|
||||
'and _strict_ = !_strict_ref',
|
||||
output,
|
||||
)
|
||||
# Fix set-strict!: use _strict_ref instead of local ref
|
||||
output = re.sub(
|
||||
r'and set_strict_b val\' =\n let _strict_ = ref Nil in \(_strict_ := val\'; Nil\)',
|
||||
"and set_strict_b val' =\n _strict_ref := val'; Nil",
|
||||
output,
|
||||
)
|
||||
# Fix *prim-param-types*: use _prim_param_types_ref
|
||||
output = re.sub(
|
||||
r'and _prim_param_types_ =\n Nil',
|
||||
'and _prim_param_types_ = !_prim_param_types_ref',
|
||||
output,
|
||||
)
|
||||
# Fix set-prim-param-types!: use _prim_param_types_ref
|
||||
output = re.sub(
|
||||
r'and set_prim_param_types_b types =\n let _prim_param_types_ = ref Nil in \(_prim_param_types_ := types; Nil\)',
|
||||
"and set_prim_param_types_b types =\n _prim_param_types_ref := types; Nil",
|
||||
output,
|
||||
)
|
||||
|
||||
# Fix all runtime reads of _strict_ and _prim_param_types_ to deref
|
||||
# the mutable refs instead of using the stale let-rec bindings.
|
||||
# This is needed because let-rec value bindings capture initial values.
|
||||
# Use regex with word boundary to avoid replacing _strict_ref with
|
||||
# !_strict_refref.
|
||||
def fix_mutable_reads(text):
|
||||
lines = text.split('\n')
|
||||
fixed = []
|
||||
for line in lines:
|
||||
# Skip the definition lines
|
||||
stripped = line.strip()
|
||||
if stripped.startswith('and _strict_ =') or stripped.startswith('and _prim_param_types_ ='):
|
||||
fixed.append(line)
|
||||
continue
|
||||
# Replace _strict_ as a standalone identifier only (not inside
|
||||
# other names like set_strict_b). Match when preceded by space,
|
||||
# paren, or start-of-line, and followed by space, paren, or ;.
|
||||
line = re.sub(r'(?<=[ (])_strict_(?=[ );])', '!_strict_ref', line)
|
||||
line = re.sub(r'(?<=[ (])_prim_param_types_(?=[ );])', '!_prim_param_types_ref', line)
|
||||
fixed.append(line)
|
||||
return '\n'.join(fixed)
|
||||
output = fix_mutable_reads(output)
|
||||
|
||||
# Fix cek_call: the spec passes (make-env) as the env arg to
|
||||
# continue_with_call, but the transpiler evaluates make-env at
|
||||
# transpile time (it's a primitive), producing Dict instead of Env.
|
||||
output = output.replace(
|
||||
"((Dict (Hashtbl.create 0))) (a) ((List []))",
|
||||
"(Env (Sx_types.make_env ())) (a) ((List []))",
|
||||
)
|
||||
|
||||
# Inject JIT dispatch into continue_with_call's lambda branch.
|
||||
# After params are bound, check jit_call_hook before creating CEK state.
|
||||
lambda_body_pattern = (
|
||||
'(prim_call "slice" [params; (len (args))])); Nil)) in '
|
||||
'(make_cek_state ((lambda_body (f))) (local) (kont))'
|
||||
)
|
||||
lambda_body_jit = (
|
||||
'(prim_call "slice" [params; (len (args))])); Nil)) in '
|
||||
'(match !jit_call_hook, f with '
|
||||
'| Some hook, Lambda l when l.l_name <> None -> '
|
||||
'let args_list = match args with '
|
||||
'List a | ListRef { contents = a } -> a | _ -> [] in '
|
||||
'(match hook f args_list with '
|
||||
'Some result -> make_cek_value result local kont '
|
||||
'| None -> make_cek_state (lambda_body f) local kont) '
|
||||
'| _ -> make_cek_state ((lambda_body (f))) (local) (kont))'
|
||||
)
|
||||
if lambda_body_pattern in output:
|
||||
output = output.replace(lambda_body_pattern, lambda_body_jit, 1)
|
||||
else:
|
||||
import sys
|
||||
print("WARNING: Could not find lambda body pattern for JIT injection", file=sys.stderr)
|
||||
|
||||
return output
|
||||
|
||||
|
||||
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()
|
||||
18
hosts/ocaml/browser/test_page_render.js
Normal file
18
hosts/ocaml/browser/test_page_render.js
Normal file
@@ -0,0 +1,18 @@
|
||||
const path = require("path");
|
||||
const fs = require("fs");
|
||||
require(path.join(__dirname, "../_build/default/browser/sx_browser.bc.js"));
|
||||
require(path.join(__dirname, "sx-platform.js"));
|
||||
const K = globalThis.SxKernel;
|
||||
for (const n of ["signals","deps","page-helpers","router","adapter-html"])
|
||||
K.loadSource(fs.readFileSync(path.join(__dirname,`../../../web/${n}.sx`),"utf8"));
|
||||
K.loadSource(fs.readFileSync("/tmp/comp_defs.txt","utf8"));
|
||||
|
||||
const pageSx = fs.readFileSync("/tmp/page_sx.txt","utf8");
|
||||
const parsed = K.parse(pageSx);
|
||||
const html = K.renderToHtml(parsed[0]);
|
||||
if (typeof html === "string" && !html.startsWith("Error:")) {
|
||||
console.log("SUCCESS! Rendered", html.length, "chars of HTML");
|
||||
console.log("Preview:", html.substring(0, 200));
|
||||
} else {
|
||||
console.log("Error:", html);
|
||||
}
|
||||
25
hosts/ocaml/browser/test_signals.js
Normal file
25
hosts/ocaml/browser/test_signals.js
Normal file
@@ -0,0 +1,25 @@
|
||||
const path = require("path");
|
||||
const fs = require("fs");
|
||||
require(path.join(__dirname, "../_build/default/browser/sx_browser.bc.js"));
|
||||
require(path.join(__dirname, "sx-platform.js"));
|
||||
const K = globalThis.SxKernel;
|
||||
for (const n of ["signals","deps","page-helpers","router","adapter-html"])
|
||||
K.loadSource(fs.readFileSync(path.join(__dirname,`../../../web/${n}.sx`),"utf8"));
|
||||
|
||||
// Test signal basics
|
||||
const tests = [
|
||||
'(signal 42)',
|
||||
'(let ((s (signal 42))) (deref s))',
|
||||
'(let ((s (signal 42))) (reset! s 100) (deref s))',
|
||||
'(let ((s (signal 10))) (swap! s (fn (v) (* v 2))) (deref s))',
|
||||
'(let ((s (signal 0))) (computed (fn () (+ (deref s) 1))))',
|
||||
'(let ((idx (signal 0))) (let ((c (computed (fn () (+ (deref idx) 10))))) (deref c)))',
|
||||
];
|
||||
|
||||
for (const t of tests) {
|
||||
const r = K.eval(t);
|
||||
const s = JSON.stringify(r);
|
||||
console.log(`${t.substring(0,60)}`);
|
||||
console.log(` => ${s && s.length > 100 ? s.substring(0,100) + '...' : s}`);
|
||||
console.log();
|
||||
}
|
||||
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))
|
||||
213
hosts/ocaml/lib/sx_parser.ml
Normal file
213
hosts/ocaml/lib/sx_parser.ml
Normal file
@@ -0,0 +1,213 @@
|
||||
(** 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 ()
|
||||
|
||||
(* Character classification — matches spec/parser.sx ident-start/ident-char.
|
||||
ident-start: a-z A-Z _ ~ * + - > < = / ! ? &
|
||||
ident-char: ident-start plus 0-9 . : / # , *)
|
||||
let is_ident_start = function
|
||||
| 'a'..'z' | 'A'..'Z' | '_' | '~' | '*' | '+' | '-'
|
||||
| '>' | '<' | '=' | '/' | '!' | '?' | '&' -> true
|
||||
| _ -> false
|
||||
|
||||
let is_ident_char = function
|
||||
| c when is_ident_start c -> true
|
||||
| '0'..'9' | '.' | ':' | '#' | ',' -> true
|
||||
| _ -> false
|
||||
|
||||
(* Symbol reading uses ident_char; first char must be ident_start or digit/colon *)
|
||||
let is_symbol_char = is_ident_char
|
||||
|
||||
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 ()
|
||||
| ',' ->
|
||||
(* Unquote / splice-unquote — matches spec: , always triggers unquote *)
|
||||
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]
|
||||
| _ ->
|
||||
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
|
||||
813
hosts/ocaml/lib/sx_primitives.ml
Normal file
813
hosts/ocaml/lib/sx_primitives.ml
Normal file
@@ -0,0 +1,813 @@
|
||||
(** 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
|
||||
|
||||
(** Forward refs for calling SX functions from primitives (breaks cycle). *)
|
||||
let _sx_call_fn : (value -> value list -> value) ref =
|
||||
ref (fun _ _ -> raise (Eval_error "sx_call not initialized"))
|
||||
let _sx_trampoline_fn : (value -> value) ref =
|
||||
ref (fun v -> v)
|
||||
|
||||
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 ^ ": " ^ (match v with Dict d -> (match Hashtbl.find_opt d "__signal" with Some _ -> "signal{value=" ^ (match Hashtbl.find_opt d "value" with Some v' -> value_to_string v' | None -> "?") ^ "}" | None -> "dict") | _ -> "")))
|
||||
|
||||
let as_string = function
|
||||
| String s -> s
|
||||
| v -> raise (Eval_error ("Expected string, got " ^ type_of v))
|
||||
|
||||
let rec as_list = function
|
||||
| List l -> l
|
||||
| ListRef r -> !r
|
||||
| Nil -> []
|
||||
| Thunk _ as t -> as_list (!_sx_trampoline_fn t)
|
||||
| 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 (floor (as_number a))
|
||||
| _ -> raise (Eval_error "floor: 1 arg"));
|
||||
register "ceil" (fun args ->
|
||||
match args with [a] -> Number (ceil (as_number a))
|
||||
| _ -> 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)
|
||||
| [String s; default_val] ->
|
||||
(match int_of_string_opt s with Some n -> Number (float_of_int n) | None -> default_val)
|
||||
| [Number n] | [Number n; _] -> Number (float_of_int (int_of_float n))
|
||||
| [_; default_val] -> default_val
|
||||
| _ -> 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 ->
|
||||
let to_str = function
|
||||
| String s -> s | SxExpr s -> s | RawHTML s -> s
|
||||
| Keyword k -> k | Symbol s -> s
|
||||
| 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
|
||||
| Thunk _ as t -> (match !_sx_trampoline_fn t with String s -> s | v -> to_string v)
|
||||
| v -> to_string v
|
||||
in
|
||||
match args with
|
||||
| [s; old_s; new_s] ->
|
||||
let s = to_str s and old_s = to_str old_s and new_s = to_str new_s in
|
||||
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] | [Bool false] -> Number 0.0
|
||||
| [Bool true] -> Number 1.0
|
||||
| [Number _] -> Number 1.0
|
||||
| [RawHTML s] -> Number (float_of_int (String.length s))
|
||||
| [SxExpr s] -> Number (float_of_int (String.length s))
|
||||
| [Spread pairs] -> Number (float_of_int (List.length pairs))
|
||||
| [Component _] | [Island _] | [Lambda _] | [NativeFn _]
|
||||
| [Macro _] | [Thunk _] | [Keyword _] | [Symbol _] -> Number 0.0
|
||||
| _ -> raise (Eval_error (Printf.sprintf "len: %d args"
|
||||
(List.length args))));
|
||||
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 "init" (fun args ->
|
||||
match args with
|
||||
| [List l] | [ListRef { contents = l }] ->
|
||||
(match List.rev l with _ :: rest -> List (List.rev rest) | [] -> List [])
|
||||
| _ -> raise (Eval_error "init: 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)
|
||||
| [String s; Number n] ->
|
||||
let i = int_of_float n in
|
||||
if i >= 0 && i < String.length s then String (String.make 1 s.[i])
|
||||
else Nil
|
||||
| _ -> raise (Eval_error "nth: list/string 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 ->
|
||||
match args with
|
||||
| [List la | ListRef { contents = la }; List lb | ListRef { contents = lb }] ->
|
||||
List (la @ lb)
|
||||
| [List la | ListRef { contents = la }; Nil] -> List la
|
||||
| [Nil; List lb | ListRef { contents = lb }] -> List lb
|
||||
| [List la | ListRef { contents = la }; v] -> List (la @ [v])
|
||||
| [v; List lb | ListRef { contents = lb }] -> List ([v] @ lb)
|
||||
| _ ->
|
||||
let all = List.concat_map as_list 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)
|
||||
| [Nil; _] -> Nil (* nil.anything → nil *)
|
||||
| [_; _] -> Nil (* type mismatch → nil (matches JS/Python behavior) *)
|
||||
| _ -> Nil);
|
||||
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 "mutable-list" (fun _args -> ListRef (ref []));
|
||||
register "set-nth!" (fun args ->
|
||||
match args with
|
||||
| [ListRef r; Number n; v] ->
|
||||
let i = int_of_float n in
|
||||
let l = !r in
|
||||
r := List.mapi (fun j x -> if j = i then v else x) l;
|
||||
Nil
|
||||
| [List _; _; _] ->
|
||||
raise (Eval_error "set-nth!: list is immutable, use ListRef")
|
||||
| _ -> raise (Eval_error "set-nth!: expected (list idx val)"));
|
||||
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 "serialize" (fun args ->
|
||||
match args with
|
||||
| [a] -> String (inspect a) (* used for dedup keys in compiler *)
|
||||
| _ -> raise (Eval_error "serialize: 1 arg"));
|
||||
register "make-symbol" (fun args ->
|
||||
match args with
|
||||
| [String s] -> Symbol s
|
||||
| _ -> raise (Eval_error "make-symbol: expected string"));
|
||||
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 | ListRef { contents = a })] -> f a
|
||||
| [NativeFn (_, f); Nil] -> f []
|
||||
| _ -> 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"));
|
||||
|
||||
(* Higher-order forms as callable primitives — used by the VM.
|
||||
The CEK machine handles these as special forms with dedicated frames;
|
||||
the VM needs them as plain callable values. *)
|
||||
(* Call any SX callable — handles NativeFn, Lambda (via trampoline), VM closures *)
|
||||
let call_any f args =
|
||||
match f with
|
||||
| NativeFn (_, fn) -> fn args
|
||||
| _ -> !_sx_trampoline_fn (!_sx_call_fn f args)
|
||||
in
|
||||
register "map" (fun args ->
|
||||
match args with
|
||||
| [f; (List items | ListRef { contents = items })] ->
|
||||
List (List.map (fun x -> call_any f [x]) items)
|
||||
| [_; Nil] -> List []
|
||||
| _ -> raise (Eval_error "map: expected (fn list)"));
|
||||
register "map-indexed" (fun args ->
|
||||
match args with
|
||||
| [f; (List items | ListRef { contents = items })] ->
|
||||
List (List.mapi (fun i x -> call_any f [Number (float_of_int i); x]) items)
|
||||
| [_; Nil] -> List []
|
||||
| _ -> raise (Eval_error "map-indexed: expected (fn list)"));
|
||||
register "filter" (fun args ->
|
||||
match args with
|
||||
| [f; (List items | ListRef { contents = items })] ->
|
||||
List (List.filter (fun x -> sx_truthy (call_any f [x])) items)
|
||||
| [_; Nil] -> List []
|
||||
| _ -> raise (Eval_error "filter: expected (fn list)"));
|
||||
register "for-each" (fun args ->
|
||||
match args with
|
||||
| [f; (List items | ListRef { contents = items })] ->
|
||||
List.iter (fun x -> ignore (call_any f [x])) items; Nil
|
||||
| [_; Nil] -> Nil (* nil collection = no-op *)
|
||||
| _ ->
|
||||
let types = String.concat ", " (List.map (fun v -> type_of v) args) in
|
||||
raise (Eval_error (Printf.sprintf "for-each: expected (fn list), got (%s) %d args" types (List.length args))));
|
||||
register "reduce" (fun args ->
|
||||
match args with
|
||||
| [f; init; (List items | ListRef { contents = items })] ->
|
||||
List.fold_left (fun acc x -> call_any f [acc; x]) init items
|
||||
| _ -> raise (Eval_error "reduce: expected (fn init list)"));
|
||||
register "some" (fun args ->
|
||||
match args with
|
||||
| [f; (List items | ListRef { contents = items })] ->
|
||||
(try List.find (fun x -> sx_truthy (call_any f [x])) items
|
||||
with Not_found -> Bool false)
|
||||
| [_; Nil] -> Bool false
|
||||
| _ -> raise (Eval_error "some: expected (fn list)"));
|
||||
register "every?" (fun args ->
|
||||
match args with
|
||||
| [f; (List items | ListRef { contents = items })] ->
|
||||
Bool (List.for_all (fun x -> sx_truthy (call_any f [x])) items)
|
||||
| [_; Nil] -> Bool true
|
||||
| _ -> raise (Eval_error "every?: expected (fn list)"));
|
||||
|
||||
(* ---- VM stack primitives (vm.sx platform interface) ---- *)
|
||||
register "make-vm-stack" (fun args ->
|
||||
match args with
|
||||
| [Number n] -> ListRef (ref (List.init (int_of_float n) (fun _ -> Nil)))
|
||||
| _ -> raise (Eval_error "make-vm-stack: expected (size)"));
|
||||
register "vm-stack-get" (fun args ->
|
||||
match args with
|
||||
| [ListRef r; Number n] -> List.nth !r (int_of_float n)
|
||||
| _ -> raise (Eval_error "vm-stack-get: expected (stack idx)"));
|
||||
register "vm-stack-set!" (fun args ->
|
||||
match args with
|
||||
| [ListRef r; Number n; v] ->
|
||||
let i = int_of_float n in
|
||||
r := List.mapi (fun j x -> if j = i then v else x) !r; Nil
|
||||
| _ -> raise (Eval_error "vm-stack-set!: expected (stack idx val)"));
|
||||
register "vm-stack-length" (fun args ->
|
||||
match args with
|
||||
| [ListRef r] -> Number (float_of_int (List.length !r))
|
||||
| _ -> raise (Eval_error "vm-stack-length: expected (stack)"));
|
||||
register "vm-stack-copy!" (fun args ->
|
||||
match args with
|
||||
| [ListRef src; ListRef dst; Number n] ->
|
||||
let count = int_of_float n in
|
||||
let src_items = !src in
|
||||
dst := List.mapi (fun i x -> if i < count then List.nth src_items i else x) !dst; Nil
|
||||
| _ -> raise (Eval_error "vm-stack-copy!: expected (src dst count)"));
|
||||
register "primitive?" (fun args ->
|
||||
match args with
|
||||
| [String name] -> Bool (Hashtbl.mem primitives name)
|
||||
| _ -> Bool false);
|
||||
|
||||
(* Scope stack primitives are registered by sx_server.ml / run_tests.ml
|
||||
because they use a shared scope stacks table with collect!/collected. *)
|
||||
|
||||
(* ---- Predicates needed by adapter-html.sx ---- *)
|
||||
register "lambda?" (fun args ->
|
||||
match args with [Lambda _] -> Bool true | _ -> Bool false);
|
||||
register "island?" (fun args ->
|
||||
match args with [Island _] -> Bool true | _ -> Bool false);
|
||||
register "is-else-clause?" (fun args ->
|
||||
match args with
|
||||
| [Keyword "else"] -> Bool true
|
||||
| [Bool true] -> Bool true
|
||||
| _ -> Bool false);
|
||||
register "component?" (fun args ->
|
||||
match args with [Component _] -> Bool true | [Island _] -> Bool true | _ -> Bool false);
|
||||
register "lambda-closure" (fun args ->
|
||||
match args with [Lambda l] -> Env l.l_closure | _ -> Nil);
|
||||
register "component-closure" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> Env c.c_closure
|
||||
| [Island i] -> Env i.i_closure
|
||||
| _ -> Nil);
|
||||
register "component-has-children?" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> Bool c.c_has_children
|
||||
| [Island i] -> Bool i.i_has_children
|
||||
| _ -> Bool false);
|
||||
register "component-name" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> String c.c_name
|
||||
| [Island i] -> String i.i_name
|
||||
| _ -> Nil);
|
||||
register "component-params" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> List (List.map (fun s -> String s) c.c_params)
|
||||
| [Island i] -> List (List.map (fun s -> String s) i.i_params)
|
||||
| _ -> List []);
|
||||
register "component-body" (fun args ->
|
||||
match args with
|
||||
| [Component c] -> c.c_body
|
||||
| [Island i] -> i.i_body
|
||||
| _ -> Nil);
|
||||
register "macro?" (fun args ->
|
||||
match args with [Macro _] -> Bool true | _ -> Bool false);
|
||||
register "for-each-indexed" (fun args ->
|
||||
match args with
|
||||
| [f; (List items | ListRef { contents = items })] ->
|
||||
List.iteri (fun i x -> ignore (call_any f [Number (float_of_int i); x])) items; Nil
|
||||
| _ -> raise (Eval_error "for-each-indexed: expected (fn list)"));
|
||||
register "lambda-params" (fun args ->
|
||||
match args with
|
||||
| [Lambda l] -> List (List.map (fun s -> String s) l.l_params)
|
||||
| _ -> List []);
|
||||
register "lambda-body" (fun args ->
|
||||
match args with [Lambda l] -> l.l_body | _ -> Nil);
|
||||
(* expand-macro is registered later by run_tests.ml / sx_server.ml
|
||||
because it needs eval_expr which creates a dependency cycle *);
|
||||
register "empty-dict?" (fun args ->
|
||||
match args with
|
||||
| [Dict d] -> Bool (Hashtbl.length d = 0)
|
||||
| _ -> Bool true);
|
||||
register "make-raw-html" (fun args ->
|
||||
match args with [String s] -> RawHTML s | _ -> Nil);
|
||||
register "raw-html-content" (fun args ->
|
||||
match args with [RawHTML s] -> String s | _ -> String "");
|
||||
register "get-primitive" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
(match Hashtbl.find_opt primitives name with
|
||||
| Some fn -> NativeFn (name, fn)
|
||||
| None -> raise (Eval_error ("VM undefined: " ^ name)))
|
||||
| _ -> raise (Eval_error "get-primitive: expected (name)"));
|
||||
register "call-primitive" (fun args ->
|
||||
match args with
|
||||
| [String name; (List a | ListRef { contents = a })] ->
|
||||
(match Hashtbl.find_opt primitives name with
|
||||
| Some fn -> fn a
|
||||
| None -> raise (Eval_error ("VM undefined: " ^ name)))
|
||||
| [String name; Nil] ->
|
||||
(match Hashtbl.find_opt primitives name with
|
||||
| Some fn -> fn []
|
||||
| None -> raise (Eval_error ("VM undefined: " ^ name)))
|
||||
| _ -> raise (Eval_error "call-primitive: expected (name args-list)"));
|
||||
()
|
||||
531
hosts/ocaml/lib/sx_ref.ml
Normal file
531
hosts/ocaml/lib/sx_ref.ml
Normal file
File diff suppressed because one or more lines are too long
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user