Compare commits
359 Commits
e4e8b45cb4
...
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 |
@@ -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
|
.git
|
||||||
.gitea
|
.gitea/workflows
|
||||||
.env
|
.env
|
||||||
_snapshot
|
_snapshot
|
||||||
docs
|
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:
|
on:
|
||||||
push:
|
push:
|
||||||
@@ -7,9 +7,10 @@ on:
|
|||||||
env:
|
env:
|
||||||
REGISTRY: registry.rose-ash.com:5000
|
REGISTRY: registry.rose-ash.com:5000
|
||||||
APP_DIR: /root/rose-ash
|
APP_DIR: /root/rose-ash
|
||||||
|
BUILD_DIR: /root/rose-ash-ci
|
||||||
|
|
||||||
jobs:
|
jobs:
|
||||||
build-and-deploy:
|
test-build-deploy:
|
||||||
runs-on: ubuntu-latest
|
runs-on: ubuntu-latest
|
||||||
steps:
|
steps:
|
||||||
- uses: actions/checkout@v4
|
- uses: actions/checkout@v4
|
||||||
@@ -28,28 +29,55 @@ jobs:
|
|||||||
chmod 600 ~/.ssh/id_rsa
|
chmod 600 ~/.ssh/id_rsa
|
||||||
ssh-keyscan -H "$DEPLOY_HOST" >> ~/.ssh/known_hosts 2>/dev/null || true
|
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
|
- name: Build and deploy changed apps
|
||||||
env:
|
env:
|
||||||
DEPLOY_HOST: ${{ secrets.DEPLOY_HOST }}
|
DEPLOY_HOST: ${{ secrets.DEPLOY_HOST }}
|
||||||
run: |
|
run: |
|
||||||
ssh "root@$DEPLOY_HOST" "
|
ssh "root@$DEPLOY_HOST" "
|
||||||
cd ${{ env.APP_DIR }}
|
cd ${{ env.BUILD_DIR }}
|
||||||
|
|
||||||
# Save current HEAD before updating
|
# Detect changes using push event SHAs (not local checkout state)
|
||||||
OLD_HEAD=\$(git rev-parse HEAD 2>/dev/null || echo none)
|
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
|
REBUILD_ALL=false
|
||||||
if [ \"\$OLD_HEAD\" = \"none\" ] || [ \"\$OLD_HEAD\" = \"\$NEW_HEAD\" ]; then
|
if [ -z \"\$BEFORE\" ] || [ \"\$BEFORE\" = '0000000000000000000000000000000000000000' ] || ! git cat-file -e \"\$BEFORE\" 2>/dev/null; then
|
||||||
# First deploy or CI re-run on same commit — rebuild all
|
# New branch, force push, or unreachable parent — rebuild all
|
||||||
REBUILD_ALL=true
|
REBUILD_ALL=true
|
||||||
else
|
else
|
||||||
CHANGED=\$(git diff --name-only \$OLD_HEAD \$NEW_HEAD)
|
CHANGED=\$(git diff --name-only \$BEFORE \$AFTER)
|
||||||
if echo \"\$CHANGED\" | grep -q '^shared/'; then
|
if echo \"\$CHANGED\" | grep -q '^shared/'; then
|
||||||
REBUILD_ALL=true
|
REBUILD_ALL=true
|
||||||
fi
|
fi
|
||||||
@@ -86,8 +114,8 @@ jobs:
|
|||||||
|
|
||||||
# Deploy swarm stacks only on main branch
|
# Deploy swarm stacks only on main branch
|
||||||
if [ '${{ github.ref_name }}' = 'main' ]; then
|
if [ '${{ github.ref_name }}' = 'main' ]; then
|
||||||
source .env
|
source ${{ env.APP_DIR }}/.env
|
||||||
docker stack deploy -c docker-compose.yml rose-ash
|
docker stack deploy --resolve-image always -c docker-compose.yml rose-ash
|
||||||
echo 'Waiting for swarm services to update...'
|
echo 'Waiting for swarm services to update...'
|
||||||
sleep 10
|
sleep 10
|
||||||
docker stack services rose-ash
|
docker stack services rose-ash
|
||||||
@@ -99,17 +127,17 @@ jobs:
|
|||||||
fi
|
fi
|
||||||
if [ \"\$SX_REBUILT\" = true ]; then
|
if [ \"\$SX_REBUILT\" = true ]; then
|
||||||
echo 'Deploying sx-web stack (sx-web.org)...'
|
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
|
sleep 5
|
||||||
docker stack services sx-web
|
docker stack services sx-web
|
||||||
# Reload Caddy to pick up any Caddyfile changes
|
|
||||||
docker service update --force caddy_caddy 2>/dev/null || true
|
docker service update --force caddy_caddy 2>/dev/null || true
|
||||||
fi
|
fi
|
||||||
else
|
else
|
||||||
echo 'Skipping swarm deploy (branch: ${{ github.ref_name }})'
|
echo 'Skipping swarm deploy (branch: ${{ github.ref_name }})'
|
||||||
fi
|
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...'
|
echo 'Deploying dev stack...'
|
||||||
docker compose -p rose-ash-dev -f docker-compose.yml -f docker-compose.dev.yml up -d
|
docker compose -p rose-ash-dev -f docker-compose.yml -f docker-compose.dev.yml up -d
|
||||||
echo 'Dev stack deployed'
|
echo 'Dev stack deployed'
|
||||||
|
|||||||
5
.gitignore
vendored
5
.gitignore
vendored
@@ -1,6 +1,7 @@
|
|||||||
__pycache__/
|
__pycache__/
|
||||||
*.pyc
|
*.pyc
|
||||||
*.pyo
|
*.pyo
|
||||||
|
shared/sx/.cache/
|
||||||
.env
|
.env
|
||||||
node_modules/
|
node_modules/
|
||||||
*.egg-info/
|
*.egg-info/
|
||||||
@@ -10,3 +11,7 @@ build/
|
|||||||
venv/
|
venv/
|
||||||
_snapshot/
|
_snapshot/
|
||||||
_debug/
|
_debug/
|
||||||
|
sx-haskell/
|
||||||
|
sx-rust/
|
||||||
|
shared/static/scripts/sx-full-test.js
|
||||||
|
hosts/ocaml/_build/
|
||||||
|
|||||||
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)
|
;; Auth page components (device auth — account-specific)
|
||||||
;; Login and check-email components are shared: see shared/sx/templates/auth.sx
|
;; 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
|
(when error
|
||||||
(div :class "bg-red-50 border border-red-200 text-red-700 p-3 rounded mb-4"
|
(div :class "bg-red-50 border border-red-200 text-red-700 p-3 rounded mb-4"
|
||||||
error)))
|
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"
|
(div :class "py-8 max-w-md mx-auto"
|
||||||
(h1 :class "text-2xl font-bold mb-6" "Authorize device")
|
(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.")
|
(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"
|
:class "w-full bg-stone-800 text-white py-2 px-4 rounded hover:bg-stone-700 transition"
|
||||||
"Authorize"))))
|
"Authorize"))))
|
||||||
|
|
||||||
(defcomp ~account-device-approved ()
|
(defcomp ~auth/device-approved ()
|
||||||
(div :class "py-8 max-w-md mx-auto text-center"
|
(div :class "py-8 max-w-md mx-auto text-center"
|
||||||
(h1 :class "text-2xl font-bold mb-4" "Device authorized")
|
(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.")))
|
(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.
|
;; Assembled auth page content — replaces Python _login_page_content etc.
|
||||||
|
|
||||||
(defcomp ~account-login-content (&key error email)
|
(defcomp ~auth/login-content (&key (error :as string?) (email :as string?))
|
||||||
(~auth-login-form
|
(~shared:auth/login-form
|
||||||
:error (when error (~auth-error-banner :error error))
|
:error (when error (~shared:auth/error-banner :error error))
|
||||||
:action (url-for "auth.start_login")
|
:action (url-for "auth.start_login")
|
||||||
:csrf-token (csrf-token)
|
:csrf-token (csrf-token)
|
||||||
:email (or email "")))
|
:email (or email "")))
|
||||||
|
|
||||||
(defcomp ~account-device-content (&key error code)
|
(defcomp ~auth/device-content (&key (error :as string?) (code :as string?))
|
||||||
(~account-device-form
|
(~auth/device-form
|
||||||
:error (when error (~account-device-error :error error))
|
:error (when error (~auth/device-error :error error))
|
||||||
:action (url-for "auth.device_submit")
|
:action (url-for "auth.device_submit")
|
||||||
:csrf-token (csrf-token)
|
:csrf-token (csrf-token)
|
||||||
:code (or code "")))
|
:code (or code "")))
|
||||||
|
|
||||||
(defcomp ~account-check-email-content (&key email email-error)
|
(defcomp ~auth/check-email-content (&key (email :as string?) (email-error :as string?))
|
||||||
(~auth-check-email
|
(~shared:auth/check-email
|
||||||
:email (escape (or email ""))
|
:email (escape (or email ""))
|
||||||
:error (when email-error
|
: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
|
;; Account dashboard components
|
||||||
|
|
||||||
(defcomp ~account-error-banner (&key error)
|
(defcomp ~dashboard/error-banner (&key (error :as string))
|
||||||
(when error
|
(when error
|
||||||
(div :class "rounded-lg border border-red-200 bg-red-50 text-red-800 px-4 py-3 text-sm"
|
(div :class "rounded-lg border border-red-200 bg-red-50 text-red-800 px-4 py-3 text-sm"
|
||||||
error)))
|
error)))
|
||||||
|
|
||||||
(defcomp ~account-user-email (&key email)
|
(defcomp ~dashboard/user-email (&key (email :as string))
|
||||||
(when email
|
(when email
|
||||||
(p :class "text-sm text-stone-500 mt-1" 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
|
(when name
|
||||||
(p :class "text-sm text-stone-600" 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"
|
(form :action "/auth/logout/" :method "post"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf-token)
|
(input :type "hidden" :name "csrf_token" :value csrf-token)
|
||||||
(button :type "submit"
|
(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"
|
: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")))
|
(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"
|
(span :class "inline-flex items-center rounded-full border border-stone-200 px-3 py-1 text-xs font-medium bg-white/60"
|
||||||
name))
|
name))
|
||||||
|
|
||||||
(defcomp ~account-labels-section (&key items)
|
(defcomp ~dashboard/labels-section (&key items)
|
||||||
(when items
|
(when items
|
||||||
(div
|
(div
|
||||||
(h2 :class "text-base font-semibold tracking-tight mb-3" "Labels")
|
(h2 :class "text-base font-semibold tracking-tight mb-3" "Labels")
|
||||||
(div :class "flex flex-wrap gap-2" items))))
|
(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 "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"
|
(div :class "bg-white/70 backdrop-blur rounded-2xl shadow border border-stone-200 p-6 sm:p-8 space-y-8"
|
||||||
error
|
error
|
||||||
@@ -43,18 +43,18 @@
|
|||||||
labels)))
|
labels)))
|
||||||
|
|
||||||
;; Assembled dashboard content — replaces Python _account_main_panel_sx
|
;; 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))
|
(let* ((user (current-user))
|
||||||
(csrf (csrf-token)))
|
(csrf (csrf-token)))
|
||||||
(~account-main-panel
|
(~dashboard/main-panel
|
||||||
:error (when error (~account-error-banner :error error))
|
:error (when error (~dashboard/error-banner :error error))
|
||||||
:email (when (get user "email")
|
:email (when (get user "email")
|
||||||
(~account-user-email :email (get user "email")))
|
(~dashboard/user-email :email (get user "email")))
|
||||||
:name (when (get user "name")
|
:name (when (get user "name")
|
||||||
(~account-user-name :name (get user "name")))
|
(~dashboard/user-name :name (get user "name")))
|
||||||
:logout (~account-logout-form :csrf-token csrf)
|
:logout (~dashboard/logout-form :csrf-token csrf)
|
||||||
:labels (when (not (empty? (or (get user "labels") (list))))
|
:labels (when (not (empty? (or (get user "labels") (list))))
|
||||||
(~account-labels-section
|
(~dashboard/labels-section
|
||||||
:items (map (lambda (label)
|
:items (map (lambda (label)
|
||||||
(~account-label-item :name (get label "name")))
|
(~dashboard/label-item :name (get label "name")))
|
||||||
(get user "labels")))))))
|
(get user "labels")))))))
|
||||||
|
|||||||
@@ -2,19 +2,19 @@
|
|||||||
;; Registered via register_sx_layout("account", ...) in __init__.py.
|
;; Registered via register_sx_layout("account", ...) in __init__.py.
|
||||||
|
|
||||||
;; Full page: root header + auth header row in header-child
|
;; Full page: root header + auth header row in header-child
|
||||||
(defcomp ~account-layout-full ()
|
(defcomp ~layouts/full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (~auth-header-row-auto))))
|
:inner (~auth-header-row-auto))))
|
||||||
|
|
||||||
;; OOB (HTMX): auth row + root header, both with oob=true
|
;; OOB (HTMX): auth row + root header, both with oob=true
|
||||||
(defcomp ~account-layout-oob ()
|
(defcomp ~layouts/oob ()
|
||||||
(<> (~auth-header-row-auto true)
|
(<> (~auth-header-row-auto true)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
;; Mobile menu: auth section + root nav
|
;; Mobile menu: auth section + root nav
|
||||||
(defcomp ~account-layout-mobile ()
|
(defcomp ~layouts/mobile ()
|
||||||
(<> (~mobile-menu-section
|
(<> (~shared:layout/mobile-menu-section
|
||||||
:label "account" :href "/" :level 1 :colour "sky"
|
:label "account" :href "/" :level 1 :colour "sky"
|
||||||
:items (~auth-nav-items-auto))
|
:items (~auth-nav-items-auto))
|
||||||
(~root-mobile-auto)))
|
(~root-mobile-auto)))
|
||||||
|
|||||||
@@ -1,30 +1,30 @@
|
|||||||
;; Newsletter management components
|
;; Newsletter management components
|
||||||
|
|
||||||
(defcomp ~account-newsletter-desc (&key description)
|
(defcomp ~newsletters/desc (&key (description :as string))
|
||||||
(when description
|
(when description
|
||||||
(p :class "text-xs text-stone-500 mt-0.5 truncate" 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"
|
(div :id id :class "flex items-center"
|
||||||
(button :sx-post url :sx-headers hdrs :sx-target target :sx-swap "outerHTML"
|
(button :sx-post url :sx-headers hdrs :sx-target target :sx-swap "outerHTML"
|
||||||
:class cls :role "switch" :aria-checked checked
|
:class cls :role "switch" :aria-checked checked
|
||||||
(span :class knob-cls))))
|
(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 "flex items-center justify-between py-4 first:pt-0 last:pb-0"
|
||||||
(div :class "min-w-0 flex-1"
|
(div :class "min-w-0 flex-1"
|
||||||
(p :class "text-sm font-medium text-stone-800" name)
|
(p :class "text-sm font-medium text-stone-800" name)
|
||||||
desc)
|
desc)
|
||||||
(div :class "ml-4 flex-shrink-0" toggle)))
|
(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))
|
(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."))
|
(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 "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"
|
(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")
|
(h1 :class "text-xl font-semibold tracking-tight" "Newsletters")
|
||||||
@@ -32,12 +32,12 @@
|
|||||||
|
|
||||||
;; Assembled newsletters content — replaces Python _newsletters_panel_sx
|
;; Assembled newsletters content — replaces Python _newsletters_panel_sx
|
||||||
;; Takes pre-fetched newsletter-list from page helper
|
;; 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)))
|
(let* ((csrf (csrf-token)))
|
||||||
(if (empty? newsletter-list)
|
(if (empty? newsletter-list)
|
||||||
(~account-newsletter-empty)
|
(~newsletters/empty)
|
||||||
(~account-newsletters-panel
|
(~newsletters/panel
|
||||||
:list (~account-newsletter-list
|
:list (~newsletters/list
|
||||||
:items (map (lambda (item)
|
:items (map (lambda (item)
|
||||||
(let* ((nl (get item "newsletter"))
|
(let* ((nl (get item "newsletter"))
|
||||||
(un (get item "un"))
|
(un (get item "un"))
|
||||||
@@ -47,11 +47,11 @@
|
|||||||
(bg (if subscribed "bg-emerald-500" "bg-stone-300"))
|
(bg (if subscribed "bg-emerald-500" "bg-stone-300"))
|
||||||
(translate (if subscribed "translate-x-6" "translate-x-1"))
|
(translate (if subscribed "translate-x-6" "translate-x-1"))
|
||||||
(checked (if subscribed "true" "false")))
|
(checked (if subscribed "true" "false")))
|
||||||
(~account-newsletter-item
|
(~newsletters/item
|
||||||
:name (get nl "name")
|
:name (get nl "name")
|
||||||
:desc (when (get nl "description")
|
:desc (when (get nl "description")
|
||||||
(~account-newsletter-desc :description (get nl "description")))
|
(~newsletters/desc :description (get nl "description")))
|
||||||
:toggle (~account-newsletter-toggle
|
:toggle (~newsletters/toggle
|
||||||
:id (str "nl-" nid)
|
:id (str "nl-" nid)
|
||||||
:url toggle-url
|
:url toggle-url
|
||||||
:hdrs {:X-CSRFToken csrf}
|
:hdrs {:X-CSRFToken csrf}
|
||||||
|
|||||||
@@ -8,7 +8,7 @@
|
|||||||
:path "/"
|
:path "/"
|
||||||
:auth :login
|
:auth :login
|
||||||
:layout :account
|
:layout :account
|
||||||
:content (~account-dashboard-content))
|
:content (~dashboard/content))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Newsletters
|
;; Newsletters
|
||||||
@@ -19,7 +19,7 @@
|
|||||||
:auth :login
|
:auth :login
|
||||||
:layout :account
|
:layout :account
|
||||||
:data (service "account-page" "newsletters-data")
|
:data (service "account-page" "newsletters-data")
|
||||||
:content (~account-newsletters-content
|
:content (~newsletters/content
|
||||||
:newsletter-list newsletter-list
|
:newsletter-list newsletter-list
|
||||||
:account-url account-url))
|
:account-url account-url))
|
||||||
|
|
||||||
|
|||||||
Binary file not shown.
@@ -256,7 +256,7 @@ def _image(node: dict) -> str:
|
|||||||
parts.append(f':width "{_esc(width)}"')
|
parts.append(f':width "{_esc(width)}"')
|
||||||
if href:
|
if href:
|
||||||
parts.append(f':href "{_esc(href)}"')
|
parts.append(f':href "{_esc(href)}"')
|
||||||
return "(~kg-image " + " ".join(parts) + ")"
|
return "(~kg_cards/kg-image " + " ".join(parts) + ")"
|
||||||
|
|
||||||
|
|
||||||
@_converter("gallery")
|
@_converter("gallery")
|
||||||
@@ -282,14 +282,14 @@ def _gallery(node: dict) -> str:
|
|||||||
images_sx = "(list " + " ".join(rows) + ")"
|
images_sx = "(list " + " ".join(rows) + ")"
|
||||||
caption = node.get("caption", "")
|
caption = node.get("caption", "")
|
||||||
caption_attr = f" :caption {html_to_sx(caption)}" if caption else ""
|
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")
|
@_converter("html")
|
||||||
def _html_card(node: dict) -> str:
|
def _html_card(node: dict) -> str:
|
||||||
raw = node.get("html", "")
|
raw = node.get("html", "")
|
||||||
inner = html_to_sx(raw)
|
inner = html_to_sx(raw)
|
||||||
return f"(~kg-html {inner})"
|
return f"(~kg_cards/kg-html {inner})"
|
||||||
|
|
||||||
|
|
||||||
@_converter("embed")
|
@_converter("embed")
|
||||||
@@ -299,7 +299,7 @@ def _embed(node: dict) -> str:
|
|||||||
parts = [f':html "{_esc(embed_html)}"']
|
parts = [f':html "{_esc(embed_html)}"']
|
||||||
if caption:
|
if caption:
|
||||||
parts.append(f":caption {html_to_sx(caption)}")
|
parts.append(f":caption {html_to_sx(caption)}")
|
||||||
return "(~kg-embed " + " ".join(parts) + ")"
|
return "(~kg_cards/kg-embed " + " ".join(parts) + ")"
|
||||||
|
|
||||||
|
|
||||||
@_converter("bookmark")
|
@_converter("bookmark")
|
||||||
@@ -330,7 +330,7 @@ def _bookmark(node: dict) -> str:
|
|||||||
if caption:
|
if caption:
|
||||||
parts.append(f":caption {html_to_sx(caption)}")
|
parts.append(f":caption {html_to_sx(caption)}")
|
||||||
|
|
||||||
return "(~kg-bookmark " + " ".join(parts) + ")"
|
return "(~kg_cards/kg-bookmark " + " ".join(parts) + ")"
|
||||||
|
|
||||||
|
|
||||||
@_converter("callout")
|
@_converter("callout")
|
||||||
@@ -344,7 +344,7 @@ def _callout(node: dict) -> str:
|
|||||||
parts.append(f':emoji "{_esc(emoji)}"')
|
parts.append(f':emoji "{_esc(emoji)}"')
|
||||||
if inner:
|
if inner:
|
||||||
parts.append(f':content {inner}')
|
parts.append(f':content {inner}')
|
||||||
return "(~kg-callout " + " ".join(parts) + ")"
|
return "(~kg_cards/kg-callout " + " ".join(parts) + ")"
|
||||||
|
|
||||||
|
|
||||||
@_converter("button")
|
@_converter("button")
|
||||||
@@ -352,7 +352,7 @@ def _button(node: dict) -> str:
|
|||||||
text = node.get("buttonText", "")
|
text = node.get("buttonText", "")
|
||||||
url = node.get("buttonUrl", "")
|
url = node.get("buttonUrl", "")
|
||||||
alignment = node.get("alignment", "center")
|
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")
|
@_converter("toggle")
|
||||||
@@ -360,7 +360,7 @@ def _toggle(node: dict) -> str:
|
|||||||
heading = node.get("heading", "")
|
heading = node.get("heading", "")
|
||||||
inner = _convert_children(node.get("children", []))
|
inner = _convert_children(node.get("children", []))
|
||||||
content_attr = f" :content {inner}" if inner else ""
|
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")
|
@_converter("audio")
|
||||||
@@ -380,7 +380,7 @@ def _audio(node: dict) -> str:
|
|||||||
parts.append(f':duration "{duration_str}"')
|
parts.append(f':duration "{duration_str}"')
|
||||||
if thumbnail:
|
if thumbnail:
|
||||||
parts.append(f':thumbnail "{_esc(thumbnail)}"')
|
parts.append(f':thumbnail "{_esc(thumbnail)}"')
|
||||||
return "(~kg-audio " + " ".join(parts) + ")"
|
return "(~kg_cards/kg-audio " + " ".join(parts) + ")"
|
||||||
|
|
||||||
|
|
||||||
@_converter("video")
|
@_converter("video")
|
||||||
@@ -400,7 +400,7 @@ def _video(node: dict) -> str:
|
|||||||
parts.append(f':thumbnail "{_esc(thumbnail)}"')
|
parts.append(f':thumbnail "{_esc(thumbnail)}"')
|
||||||
if loop:
|
if loop:
|
||||||
parts.append(":loop true")
|
parts.append(":loop true")
|
||||||
return "(~kg-video " + " ".join(parts) + ")"
|
return "(~kg_cards/kg-video " + " ".join(parts) + ")"
|
||||||
|
|
||||||
|
|
||||||
@_converter("file")
|
@_converter("file")
|
||||||
@@ -429,12 +429,12 @@ def _file(node: dict) -> str:
|
|||||||
parts.append(f':filesize "{size_str}"')
|
parts.append(f':filesize "{size_str}"')
|
||||||
if caption:
|
if caption:
|
||||||
parts.append(f":caption {html_to_sx(caption)}")
|
parts.append(f":caption {html_to_sx(caption)}")
|
||||||
return "(~kg-file " + " ".join(parts) + ")"
|
return "(~kg_cards/kg-file " + " ".join(parts) + ")"
|
||||||
|
|
||||||
|
|
||||||
@_converter("paywall")
|
@_converter("paywall")
|
||||||
def _paywall(_node: dict) -> str:
|
def _paywall(_node: dict) -> str:
|
||||||
return "(~kg-paywall)"
|
return "(~kg_cards/kg-paywall)"
|
||||||
|
|
||||||
|
|
||||||
@_converter("markdown")
|
@_converter("markdown")
|
||||||
@@ -442,4 +442,4 @@ def _markdown(node: dict) -> str:
|
|||||||
md_text = node.get("markdown", "")
|
md_text = node.get("markdown", "")
|
||||||
rendered = mistune.html(md_text)
|
rendered = mistune.html(md_text)
|
||||||
inner = html_to_sx(rendered)
|
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
|
#!/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.
|
raw caption strings.
|
||||||
|
|
||||||
The updated lexical_to_sx converter now produces native sx expressions instead
|
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
|
captions as escaped HTML strings. This script re-runs the conversion on all
|
||||||
posts that already have sx_content, overwriting the old output.
|
posts that already have sx_content, overwriting the old output.
|
||||||
|
|
||||||
@@ -50,11 +50,11 @@ async def migrate(dry_run: bool = False) -> int:
|
|||||||
continue
|
continue
|
||||||
|
|
||||||
if dry_run:
|
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 "")
|
old_has_raw = "raw! caption" in (post.sx_content or "")
|
||||||
markers = []
|
markers = []
|
||||||
if old_has_kg:
|
if old_has_kg:
|
||||||
markers.append("~kg-html")
|
markers.append("~kg_cards/kg-html")
|
||||||
if old_has_raw:
|
if old_has_raw:
|
||||||
markers.append("raw-caption")
|
markers.append("raw-caption")
|
||||||
tag = f" [{', '.join(markers)}]" if markers else ""
|
tag = f" [{', '.join(markers)}]" if markers else ""
|
||||||
@@ -76,7 +76,7 @@ async def migrate(dry_run: bool = False) -> int:
|
|||||||
|
|
||||||
def main():
|
def main():
|
||||||
parser = argparse.ArgumentParser(
|
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",
|
parser.add_argument("--dry-run", action="store_true",
|
||||||
help="Preview changes without writing to database")
|
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):
|
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", "")
|
slug = post.get("slug", "")
|
||||||
is_admin = rights.get("admin") if isinstance(rights, dict) else getattr(rights, "admin", False)
|
is_admin = rights.get("admin") if isinstance(rights, dict) else getattr(rights, "admin", False)
|
||||||
user_id = getattr(user, "id", None) if user else None
|
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
|
;; 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 "max-w-2xl mx-auto px-4 py-6 space-y-6"
|
||||||
(div :class "flex flex-col md:flex-row gap-3 items-start"
|
(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"
|
(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"))
|
(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"))))
|
(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 "max-w-4xl mx-auto p-6"
|
||||||
(div :class "mb-6 flex justify-between items-center"
|
(div :class "mb-6 flex justify-between items-center"
|
||||||
(h1 :class "text-3xl font-bold" "Snippets"))
|
(h1 :class "text-3xl font-bold" "Snippets"))
|
||||||
(div :id "snippets-list" list)))
|
(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"
|
(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"
|
:sx-headers hx-headers :class "text-sm border border-stone-300 rounded px-2 py-1"
|
||||||
options))
|
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))
|
(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 items-center gap-4 p-4 hover:bg-stone-50 transition"
|
||||||
(div :class "flex-1 min-w-0"
|
(div :class "flex-1 min-w-0"
|
||||||
(div :class "font-medium truncate" name)
|
(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)
|
(span :class (str "inline-flex items-center px-2.5 py-0.5 rounded-full text-xs font-medium " badge-cls) visibility)
|
||||||
extra))
|
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)))
|
(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 "max-w-4xl mx-auto p-6"
|
||||||
(div :class "mb-6 flex justify-end items-center"
|
(div :class "mb-6 flex justify-end items-center"
|
||||||
(button :type "button" :sx-get new-url :sx-target "#menu-item-form" :sx-swap "innerHTML"
|
(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-item-form" :class "mb-6")
|
||||||
(div :id "menu-items-list" list)))
|
(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 "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"))
|
(div :class "text-stone-400 cursor-move" (i :class "fa fa-grip-vertical"))
|
||||||
img
|
img
|
||||||
@@ -54,16 +54,16 @@
|
|||||||
(button :type "button" :sx-get edit-url :sx-target "#menu-item-form" :sx-swap "innerHTML"
|
(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"
|
:class "px-3 py-1 text-sm bg-stone-200 hover:bg-stone-300 rounded"
|
||||||
(i :class "fa fa-edit") " Edit")
|
(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
|
:title "Delete menu item?" :text confirm-text
|
||||||
:sx-headers hx-headers))))
|
: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)))
|
(div :class "bg-white rounded-lg shadow" (div :class "divide-y" rows)))
|
||||||
|
|
||||||
;; Tag groups admin
|
;; 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"
|
(form :method "post" :action create-url :class "border rounded p-4 bg-white space-y-3"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||||
(h3 :class "text-sm font-semibold text-stone-700" "New Group")
|
(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")
|
(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")))
|
(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"))
|
(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"
|
(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))
|
: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"
|
(li :class "border rounded p-3 bg-white flex items-center gap-3"
|
||||||
icon
|
icon
|
||||||
(div :class "flex-1"
|
(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 ml-2" slug))
|
||||||
(span :class "text-xs text-stone-500" (str "order: " sort-order))))
|
(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))
|
(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))
|
(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"
|
(div :class "border-t pt-4"
|
||||||
(h3 :class "text-sm font-semibold text-stone-700 mb-2" heading)
|
(h3 :class "text-sm font-semibold text-stone-700 mb-2" heading)
|
||||||
(div :class "flex flex-wrap gap-2" spans)))
|
(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"
|
(div :class "max-w-2xl mx-auto px-4 py-6 space-y-8"
|
||||||
form groups unassigned))
|
form groups unassigned))
|
||||||
|
|
||||||
;; Tag group edit
|
;; 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"
|
(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")
|
(input :type "checkbox" :name "tag_ids" :value tag-id :checked checked :class "rounded border-stone-300")
|
||||||
img (span name)))
|
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"))
|
(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"
|
(form :method "post" :action save-url :class "border rounded p-4 bg-white space-y-4"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||||
(div :class "space-y-3"
|
(div :class "space-y-3"
|
||||||
@@ -133,19 +133,19 @@
|
|||||||
(div :class "flex gap-3"
|
(div :class "flex gap-3"
|
||||||
(button :type "submit" :class "border rounded px-4 py-2 bg-stone-800 text-white text-sm" "Save"))))
|
(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"
|
(form :method "post" :action delete-url :class "border-t pt-4"
|
||||||
:onsubmit "return confirm('Delete this tag group? Tags will not be deleted.')"
|
:onsubmit "return confirm('Delete this tag group? Tags will not be deleted.')"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(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")))
|
(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"
|
(div :class "max-w-2xl mx-auto px-4 py-6 space-y-6"
|
||||||
edit-form delete-form))
|
edit-form delete-form))
|
||||||
|
|
||||||
;; Data-driven snippets list (replaces Python _snippets_sx loop)
|
;; Data-driven snippets list (replaces Python _snippets_sx loop)
|
||||||
(defcomp ~blog-snippets-from-data (&key snippets user-id is-admin csrf badge-colours)
|
(defcomp ~admin/snippets-from-data (&key snippets user-id is-admin csrf badge-colours)
|
||||||
(~blog-snippets-list
|
(~admin/snippets-list
|
||||||
:rows (<> (map (lambda (s)
|
:rows (<> (map (lambda (s)
|
||||||
(let* ((s-id (get s "id"))
|
(let* ((s-id (get s "id"))
|
||||||
(s-name (get s "name"))
|
(s-name (get s "name"))
|
||||||
@@ -155,31 +155,31 @@
|
|||||||
(badge-cls (or (get badge-colours s-vis) "bg-stone-200 text-stone-700"))
|
(badge-cls (or (get badge-colours s-vis) "bg-stone-200 text-stone-700"))
|
||||||
(extra (<>
|
(extra (<>
|
||||||
(when is-admin
|
(when is-admin
|
||||||
(~blog-snippet-visibility-select
|
(~admin/snippet-visibility-select
|
||||||
:patch-url (get s "patch_url")
|
:patch-url (get s "patch_url")
|
||||||
:hx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")
|
:hx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")
|
||||||
:options (<>
|
:options (<>
|
||||||
(~blog-snippet-option :value "private" :selected (= s-vis "private") :label "private")
|
(~admin/snippet-option :value "private" :selected (= s-vis "private") :label "private")
|
||||||
(~blog-snippet-option :value "shared" :selected (= s-vis "shared") :label "shared")
|
(~admin/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 "admin" :selected (= s-vis "admin") :label "admin"))
|
||||||
:cls "text-sm border border-stone-300 rounded px-2 py-1"))
|
:cls "text-sm border border-stone-300 rounded px-2 py-1"))
|
||||||
(when (or (= s-uid user-id) is-admin)
|
(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?"
|
:title "Delete snippet?"
|
||||||
:text (str "Delete \u201c" s-name "\u201d?")
|
:text (str "Delete \u201c" s-name "\u201d?")
|
||||||
:sx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")
|
: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")))))
|
: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)))
|
:visibility s-vis :extra extra)))
|
||||||
(or snippets (list))))))
|
(or snippets (list))))))
|
||||||
|
|
||||||
;; Data-driven menu items list (replaces Python _menu_items_list_sx loop)
|
;; Data-driven menu items list (replaces Python _menu_items_list_sx loop)
|
||||||
(defcomp ~blog-menu-items-from-data (&key items csrf)
|
(defcomp ~admin/menu-items-from-data (&key items csrf)
|
||||||
(~blog-menu-items-list
|
(~admin/menu-items-list
|
||||||
:rows (<> (map (lambda (item)
|
: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")))
|
: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")
|
:img img :label (get item "label") :slug (get item "slug")
|
||||||
:sort-order (get item "sort_order") :edit-url (get item "edit_url")
|
:sort-order (get item "sort_order") :edit-url (get item "edit_url")
|
||||||
:delete-url (get item "delete_url")
|
:delete-url (get item "delete_url")
|
||||||
@@ -188,38 +188,38 @@
|
|||||||
(or items (list))))))
|
(or items (list))))))
|
||||||
|
|
||||||
;; Data-driven tag groups main (replaces Python _tag_groups_main_panel_sx loops)
|
;; 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)
|
(defcomp ~admin/tag-groups-from-data (&key groups unassigned-tags csrf create-url)
|
||||||
(~blog-tag-groups-main
|
(~admin/tag-groups-main
|
||||||
:form (~blog-tag-groups-create-form :create-url create-url :csrf csrf)
|
:form (~admin/tag-groups-create-form :create-url create-url :csrf csrf)
|
||||||
:groups (if (empty? (or groups (list)))
|
:groups (if (empty? (or groups (list)))
|
||||||
(~empty-state :message "No tag groups yet." :cls "text-stone-500 text-sm")
|
(~shared:misc/empty-state :message "No tag groups yet." :cls "text-stone-500 text-sm")
|
||||||
(~blog-tag-groups-list
|
(~admin/tag-groups-list
|
||||||
:items (<> (map (lambda (g)
|
:items (<> (map (lambda (g)
|
||||||
(let* ((icon (if (get g "feature_image")
|
(let* ((icon (if (get g "feature_image")
|
||||||
(~blog-tag-group-icon-image :src (get g "feature_image") :name (get g "name"))
|
(~admin/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")))))
|
(~admin/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-li :icon icon :edit-href (get g "edit_href")
|
||||||
:name (get g "name") :slug (get g "slug") :sort-order (get g "sort_order"))))
|
:name (get g "name") :slug (get g "slug") :sort-order (get g "sort_order"))))
|
||||||
groups))))
|
groups))))
|
||||||
:unassigned (when (not (empty? (or unassigned-tags (list))))
|
:unassigned (when (not (empty? (or unassigned-tags (list))))
|
||||||
(~blog-unassigned-tags
|
(~admin/unassigned-tags
|
||||||
:heading (str "Unassigned Tags (" (len unassigned-tags) ")")
|
:heading (str "Unassigned Tags (" (len unassigned-tags) ")")
|
||||||
:spans (<> (map (lambda (t)
|
:spans (<> (map (lambda (t)
|
||||||
(~blog-unassigned-tag :name (get t "name")))
|
(~admin/unassigned-tag :name (get t "name")))
|
||||||
unassigned-tags))))))
|
unassigned-tags))))))
|
||||||
|
|
||||||
;; Data-driven tag group edit (replaces Python _tag_groups_edit_main_panel_sx loop)
|
;; 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)
|
(<> (map (lambda (t)
|
||||||
(~blog-tag-checkbox
|
(~admin/tag-checkbox
|
||||||
:tag-id (get t "tag_id") :checked (get t "checked")
|
: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")))
|
:name (get t "name")))
|
||||||
(or tags (list)))))
|
(or tags (list)))))
|
||||||
|
|
||||||
;; Preview panel components
|
;; 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"
|
(div :class "max-w-4xl mx-auto px-4 py-6 space-y-4"
|
||||||
(style "
|
(style "
|
||||||
.sx-pretty, .json-pretty { font-family: monospace; font-size: 12px; line-height: 1.6; white-space: pre-wrap; }
|
.sx-pretty, .json-pretty { font-family: monospace; font-size: 12px; line-height: 1.6; white-space: pre-wrap; }
|
||||||
@@ -239,18 +239,18 @@
|
|||||||
")
|
")
|
||||||
sections))
|
sections))
|
||||||
|
|
||||||
(defcomp ~blog-preview-section (&key title content)
|
(defcomp ~admin/preview-section (&key title content)
|
||||||
(details :class "border rounded bg-white"
|
(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)
|
(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)))
|
(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)))
|
(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."))
|
(div :class "p-8 text-stone-500" "No content to preview."))
|
||||||
|
|
||||||
(defcomp ~blog-admin-placeholder ()
|
(defcomp ~admin/placeholder ()
|
||||||
(div :class "pb-8"))
|
(div :class "pb-8"))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
@@ -258,12 +258,12 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
;; Snippets — receives serialized snippet dicts from service
|
;; Snippets — receives serialized snippet dicts from service
|
||||||
(defcomp ~blog-snippets-content (&key snippets is-admin csrf)
|
(defcomp ~admin/snippets-content (&key snippets is-admin csrf)
|
||||||
(~blog-snippets-panel
|
(~admin/snippets-panel
|
||||||
:list (if (empty? (or snippets (list)))
|
: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.")
|
:message "No snippets yet. Create one from the blog editor.")
|
||||||
(~blog-snippets-list
|
(~admin/snippets-list
|
||||||
:rows (map (lambda (s)
|
:rows (map (lambda (s)
|
||||||
(let* ((badge-colours (dict
|
(let* ((badge-colours (dict
|
||||||
"private" "bg-stone-200 text-stone-700"
|
"private" "bg-stone-200 text-stone-700"
|
||||||
@@ -274,19 +274,19 @@
|
|||||||
(name (get s "name"))
|
(name (get s "name"))
|
||||||
(owner (get s "owner"))
|
(owner (get s "owner"))
|
||||||
(can-delete (get s "can_delete")))
|
(can-delete (get s "can_delete")))
|
||||||
(~blog-snippet-row
|
(~admin/snippet-row
|
||||||
:name name :owner owner :badge-cls badge-cls :visibility vis
|
:name name :owner owner :badge-cls badge-cls :visibility vis
|
||||||
:extra (<>
|
:extra (<>
|
||||||
(when is-admin
|
(when is-admin
|
||||||
(~blog-snippet-visibility-select
|
(~admin/snippet-visibility-select
|
||||||
:patch-url (get s "patch_url")
|
:patch-url (get s "patch_url")
|
||||||
:hx-headers {:X-CSRFToken csrf}
|
:hx-headers {:X-CSRFToken csrf}
|
||||||
:options (<>
|
:options (<>
|
||||||
(~blog-snippet-option :value "private" :selected (= vis "private") :label "private")
|
(~admin/snippet-option :value "private" :selected (= vis "private") :label "private")
|
||||||
(~blog-snippet-option :value "shared" :selected (= vis "shared") :label "shared")
|
(~admin/snippet-option :value "shared" :selected (= vis "shared") :label "shared")
|
||||||
(~blog-snippet-option :value "admin" :selected (= vis "admin") :label "admin"))))
|
(~admin/snippet-option :value "admin" :selected (= vis "admin") :label "admin"))))
|
||||||
(when can-delete
|
(when can-delete
|
||||||
(~delete-btn
|
(~shared:misc/delete-btn
|
||||||
:url (get s "delete_url")
|
:url (get s "delete_url")
|
||||||
:trigger-target "#snippets-list"
|
:trigger-target "#snippets-list"
|
||||||
:title "Delete snippet?"
|
:title "Delete snippet?"
|
||||||
@@ -296,16 +296,16 @@
|
|||||||
(or snippets (list)))))))
|
(or snippets (list)))))))
|
||||||
|
|
||||||
;; Menu Items — receives serialized menu item dicts from service
|
;; Menu Items — receives serialized menu item dicts from service
|
||||||
(defcomp ~blog-menu-items-content (&key menu-items new-url csrf)
|
(defcomp ~admin/menu-items-content (&key menu-items new-url csrf)
|
||||||
(~blog-menu-items-panel
|
(~admin/menu-items-panel
|
||||||
:new-url new-url
|
:new-url new-url
|
||||||
:list (if (empty? (or menu-items (list)))
|
: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!")
|
:message "No menu items yet. Add one to get started!")
|
||||||
(~blog-menu-items-list
|
(~admin/menu-items-list
|
||||||
:rows (map (lambda (mi)
|
:rows (map (lambda (mi)
|
||||||
(~blog-menu-item-row
|
(~admin/menu-item-row
|
||||||
:img (~img-or-placeholder
|
:img (~shared:misc/img-or-placeholder
|
||||||
:src (get mi "feature_image") :alt (get mi "label")
|
:src (get mi "feature_image") :alt (get mi "label")
|
||||||
:size-cls "w-12 h-12 rounded-full object-cover flex-shrink-0")
|
:size-cls "w-12 h-12 rounded-full object-cover flex-shrink-0")
|
||||||
:label (get mi "label")
|
:label (get mi "label")
|
||||||
@@ -318,23 +318,23 @@
|
|||||||
(or menu-items (list)))))))
|
(or menu-items (list)))))))
|
||||||
|
|
||||||
;; Tag Groups — receives serialized tag group data from service
|
;; Tag Groups — receives serialized tag group data from service
|
||||||
(defcomp ~blog-tag-groups-content (&key groups unassigned-tags create-url csrf)
|
(defcomp ~admin/tag-groups-content (&key groups unassigned-tags create-url csrf)
|
||||||
(~blog-tag-groups-main
|
(~admin/tag-groups-main
|
||||||
:form (~blog-tag-groups-create-form :create-url create-url :csrf csrf)
|
:form (~admin/tag-groups-create-form :create-url create-url :csrf csrf)
|
||||||
:groups (if (empty? (or groups (list)))
|
:groups (if (empty? (or groups (list)))
|
||||||
(~empty-state :icon "fa fa-tags" :message "No tag groups yet.")
|
(~shared:misc/empty-state :icon "fa fa-tags" :message "No tag groups yet.")
|
||||||
(~blog-tag-groups-list
|
(~admin/tag-groups-list
|
||||||
:items (map (lambda (g)
|
:items (map (lambda (g)
|
||||||
(let* ((fi (get g "feature_image"))
|
(let* ((fi (get g "feature_image"))
|
||||||
(colour (get g "colour"))
|
(colour (get g "colour"))
|
||||||
(name (get g "name"))
|
(name (get g "name"))
|
||||||
(initial (slice (or name "?") 0 1))
|
(initial (slice (or name "?") 0 1))
|
||||||
(icon (if fi
|
(icon (if fi
|
||||||
(~blog-tag-group-icon-image :src fi :name name)
|
(~admin/tag-group-icon-image :src fi :name name)
|
||||||
(~blog-tag-group-icon-color
|
(~admin/tag-group-icon-color
|
||||||
:style (if colour (str "background:" colour) "background:#e7e5e4")
|
:style (if colour (str "background:" colour) "background:#e7e5e4")
|
||||||
:initial initial))))
|
:initial initial))))
|
||||||
(~blog-tag-group-li
|
(~admin/tag-group-li
|
||||||
:icon icon
|
:icon icon
|
||||||
:edit-href (get g "edit_href")
|
:edit-href (get g "edit_href")
|
||||||
:name name
|
:name name
|
||||||
@@ -342,57 +342,57 @@
|
|||||||
:sort-order (or (get g "sort_order") 0))))
|
:sort-order (or (get g "sort_order") 0))))
|
||||||
(or groups (list)))))
|
(or groups (list)))))
|
||||||
:unassigned (when (not (empty? (or unassigned-tags (list))))
|
:unassigned (when (not (empty? (or unassigned-tags (list))))
|
||||||
(~blog-unassigned-tags
|
(~admin/unassigned-tags
|
||||||
:heading (str (len (or unassigned-tags (list))) " Unassigned Tags")
|
:heading (str (len (or unassigned-tags (list))) " Unassigned Tags")
|
||||||
:spans (map (lambda (t)
|
:spans (map (lambda (t)
|
||||||
(~blog-unassigned-tag :name (get t "name")))
|
(~admin/unassigned-tag :name (get t "name")))
|
||||||
(or unassigned-tags (list)))))))
|
(or unassigned-tags (list)))))))
|
||||||
|
|
||||||
;; Tag Group Edit — receives serialized tag group + tags from service
|
;; 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)
|
(defcomp ~admin/tag-group-edit-content (&key group all-tags save-url delete-url csrf)
|
||||||
(~blog-tag-group-edit-main
|
(~admin/tag-group-edit-main
|
||||||
:edit-form (~blog-tag-group-edit-form
|
:edit-form (~admin/tag-group-edit-form
|
||||||
:save-url save-url :csrf csrf
|
:save-url save-url :csrf csrf
|
||||||
:name (get group "name")
|
:name (get group "name")
|
||||||
:colour (get group "colour")
|
:colour (get group "colour")
|
||||||
:sort-order (get group "sort_order")
|
:sort-order (get group "sort_order")
|
||||||
:feature-image (get group "feature_image")
|
:feature-image (get group "feature_image")
|
||||||
:tags (map (lambda (t)
|
:tags (map (lambda (t)
|
||||||
(~blog-tag-checkbox
|
(~admin/tag-checkbox
|
||||||
:tag-id (get t "id")
|
:tag-id (get t "id")
|
||||||
:checked (get t "checked")
|
:checked (get t "checked")
|
||||||
:img (when (get t "feature_image")
|
: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")))
|
:name (get t "name")))
|
||||||
(or all-tags (list))))
|
(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
|
;; 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)))
|
(let* ((sections (list)))
|
||||||
(if (and (not sx-pretty) (not json-pretty) (not sx-rendered) (not lex-rendered))
|
(if (and (not sx-pretty) (not json-pretty) (not sx-rendered) (not lex-rendered))
|
||||||
(~blog-preview-empty)
|
(~admin/preview-empty)
|
||||||
(~blog-preview-panel :sections
|
(~admin/preview-panel :sections
|
||||||
(<>
|
(<>
|
||||||
(when sx-pretty
|
(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
|
(when json-pretty
|
||||||
(~blog-preview-section :title "Lexical JSON" :content json-pretty))
|
(~admin/preview-section :title "Lexical JSON" :content json-pretty))
|
||||||
(when sx-rendered
|
(when sx-rendered
|
||||||
(~blog-preview-section :title "SX Rendered"
|
(~admin/preview-section :title "SX Rendered"
|
||||||
:content (~blog-preview-rendered :html sx-rendered)))
|
:content (~admin/preview-rendered :html sx-rendered)))
|
||||||
(when lex-rendered
|
(when lex-rendered
|
||||||
(~blog-preview-section :title "Lexical Rendered"
|
(~admin/preview-section :title "Lexical Rendered"
|
||||||
:content (~blog-preview-rendered :html lex-rendered))))))))
|
:content (~admin/preview-rendered :html lex-rendered))))))))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Data introspection composition — replaces _h_post_data_content
|
;; 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")
|
(if (= value-type "nil")
|
||||||
(span :class "text-neutral-400" "\u2014")
|
(span :class "text-neutral-400" "\u2014")
|
||||||
(pre :class "whitespace-pre-wrap break-words break-all text-xs"
|
(pre :class "whitespace-pre-wrap break-words break-all text-xs"
|
||||||
@@ -400,7 +400,7 @@
|
|||||||
(code value)
|
(code value)
|
||||||
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"
|
(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"
|
(table :class "w-full table-fixed text-sm border border-neutral-200 rounded-xl overflow-hidden"
|
||||||
(thead :class "bg-neutral-50/70"
|
(thead :class "bg-neutral-50/70"
|
||||||
@@ -411,10 +411,10 @@
|
|||||||
(tr :class "border-t border-neutral-200 align-top"
|
(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 whitespace-nowrap text-neutral-600 align-top" (get col "key"))
|
||||||
(td :class "px-3 py-2 align-top"
|
(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)))))))
|
(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"
|
(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 whitespace-nowrap align-top" (str index))
|
||||||
(td :class "px-2 py-1 align-top"
|
(td :class "px-2 py-1 align-top"
|
||||||
@@ -422,11 +422,11 @@
|
|||||||
(code summary))
|
(code summary))
|
||||||
(when children
|
(when children
|
||||||
(div :class "mt-2 pl-3 border-l border-neutral-200"
|
(div :class "mt-2 pl-3 border-l border-neutral-200"
|
||||||
(~blog-data-model-content
|
(~admin/data-model-content
|
||||||
:columns (get children "columns")
|
:columns (get children "columns")
|
||||||
:relationships (get children "relationships")))))))
|
: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 "rounded-xl border border-neutral-200"
|
||||||
(div :class "px-3 py-2 bg-neutral-50/70 text-sm font-medium"
|
(div :class "px-3 py-2 bg-neutral-50/70 text-sm font-medium"
|
||||||
"Relationship: " (span :class "font-semibold" name)
|
"Relationship: " (span :class "font-semibold" name)
|
||||||
@@ -448,7 +448,7 @@
|
|||||||
(th :class "px-2 py-1 text-left" "Summary")))
|
(th :class "px-2 py-1 text-left" "Summary")))
|
||||||
(tbody
|
(tbody
|
||||||
(map (lambda (item)
|
(map (lambda (item)
|
||||||
(~blog-data-relationship-item
|
(~admin/data-relationship-item
|
||||||
:index (get item "index")
|
:index (get item "index")
|
||||||
:summary (get item "summary")
|
:summary (get item "summary")
|
||||||
:children (get item "children")))
|
:children (get item "children")))
|
||||||
@@ -459,17 +459,17 @@
|
|||||||
(code (get value "summary")))
|
(code (get value "summary")))
|
||||||
(when (get value "children")
|
(when (get value "children")
|
||||||
(div :class "pl-3 border-l border-neutral-200"
|
(div :class "pl-3 border-l border-neutral-200"
|
||||||
(~blog-data-model-content
|
(~admin/data-model-content
|
||||||
:columns (get (get value "children") "columns")
|
:columns (get (get value "children") "columns")
|
||||||
:relationships (get (get value "children") "relationships"))))))))))
|
: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"
|
(div :class "space-y-4"
|
||||||
(~blog-data-scalar-table :columns columns)
|
(~admin/data-scalar-table :columns columns)
|
||||||
(when (not (empty? (or relationships (list))))
|
(when (not (empty? (or relationships (list))))
|
||||||
(div :class "space-y-3"
|
(div :class "space-y-3"
|
||||||
(map (lambda (rel)
|
(map (lambda (rel)
|
||||||
(~blog-data-relationship
|
(~admin/data-relationship
|
||||||
:name (get rel "name")
|
:name (get rel "name")
|
||||||
:cardinality (get rel "cardinality")
|
:cardinality (get rel "cardinality")
|
||||||
:class-name (get rel "class_name")
|
:class-name (get rel "class_name")
|
||||||
@@ -477,13 +477,13 @@
|
|||||||
:value (get rel "value")))
|
:value (get rel "value")))
|
||||||
relationships)))))
|
relationships)))))
|
||||||
|
|
||||||
(defcomp ~blog-data-table-content (&key tablename model-data)
|
(defcomp ~admin/data-table-content (&key tablename model-data)
|
||||||
(if (not 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 text-stone-400" "No post data available.")
|
||||||
(div :class "px-4 py-8"
|
(div :class "px-4 py-8"
|
||||||
(div :class "mb-6 text-sm text-neutral-500"
|
(div :class "mb-6 text-sm text-neutral-500"
|
||||||
"Model: " (code "Post") " \u2022 Table: " (code tablename))
|
"Model: " (code "Post") " \u2022 Table: " (code tablename))
|
||||||
(~blog-data-model-content
|
(~admin/data-model-content
|
||||||
:columns (get model-data "columns")
|
:columns (get model-data "columns")
|
||||||
:relationships (get model-data "relationships")))))
|
:relationships (get model-data "relationships")))))
|
||||||
|
|
||||||
@@ -491,7 +491,7 @@
|
|||||||
;; Calendar month view for browsing/toggling entries (B1)
|
;; 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"
|
(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)
|
(span :class "truncate flex-1" name)
|
||||||
(button :type "button" :class "flex-shrink-0 hover:text-red-600"
|
(button :type "button" :class "flex-shrink-0 hover:text-red-600"
|
||||||
@@ -505,7 +505,7 @@
|
|||||||
:sx-on:afterSwap "document.body.dispatchEvent(new CustomEvent('entryToggled'))"
|
:sx-on:afterSwap "document.body.dispatchEvent(new CustomEvent('entryToggled'))"
|
||||||
(i :class "fa fa-times"))))
|
(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"
|
(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"
|
: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?"
|
:data-confirm "" :data-confirm-title "Add entry?"
|
||||||
@@ -518,7 +518,7 @@
|
|||||||
:sx-on:afterSwap "document.body.dispatchEvent(new CustomEvent('entryToggled'))"
|
:sx-on:afterSwap "document.body.dispatchEvent(new CustomEvent('entryToggled'))"
|
||||||
(span :class "truncate block" name)))
|
(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
|
current-url prev-month-url prev-year-url
|
||||||
next-month-url next-year-url
|
next-month-url next-year-url
|
||||||
weekday-names days csrf)
|
weekday-names days csrf)
|
||||||
@@ -553,9 +553,9 @@
|
|||||||
(div :class "space-y-0.5"
|
(div :class "space-y-0.5"
|
||||||
(map (lambda (e)
|
(map (lambda (e)
|
||||||
(if (get e "is_associated")
|
(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)
|
: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)))
|
:name (get e "name") :toggle-url (get e "toggle_url") :csrf csrf)))
|
||||||
entries))))))
|
entries))))))
|
||||||
(or days (list))))))))
|
(or days (list))))))))
|
||||||
@@ -564,15 +564,15 @@
|
|||||||
;; Nav entries OOB — renders associated entry/calendar items in scroll wrapper (B2)
|
;; 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)))
|
(let* ((entry-list (or entries (list)))
|
||||||
(cal-list (or calendars (list)))
|
(cal-list (or calendars (list)))
|
||||||
(has-items (or (not (empty? entry-list)) (not (empty? cal-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")
|
(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"))
|
(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)
|
(if (not has-items)
|
||||||
(~blog-nav-entries-empty)
|
(~shared:nav/blog-nav-entries-empty)
|
||||||
(~scroll-nav-wrapper
|
(~shared:misc/scroll-nav-wrapper
|
||||||
:wrapper-id "entries-calendars-nav-wrapper"
|
:wrapper-id "entries-calendars-nav-wrapper"
|
||||||
:container-id "associated-items-container"
|
:container-id "associated-items-container"
|
||||||
:arrow-cls "entries-nav-arrow"
|
:arrow-cls "entries-nav-arrow"
|
||||||
@@ -581,12 +581,12 @@
|
|||||||
:right-hs "on click set #associated-items-container.scrollLeft to #associated-items-container.scrollLeft + 200"
|
:right-hs "on click set #associated-items-container.scrollLeft to #associated-items-container.scrollLeft + 200"
|
||||||
:items (<>
|
:items (<>
|
||||||
(map (lambda (e)
|
(map (lambda (e)
|
||||||
(~calendar-entry-nav
|
(~shared:navigation/calendar-entry-nav
|
||||||
:href (get e "href") :nav-class nav-cls
|
:href (get e "href") :nav-class nav-cls
|
||||||
:name (get e "name") :date-str (get e "date_str")))
|
:name (get e "name") :date-str (get e "date_str")))
|
||||||
entry-list)
|
entry-list)
|
||||||
(map (lambda (c)
|
(map (lambda (c)
|
||||||
(~blog-nav-calendar-item
|
(~shared:nav/blog-nav-calendar-item
|
||||||
:href (get c "href") :nav-cls nav-cls
|
:href (get c "href") :nav-cls nav-cls
|
||||||
:name (get c "name")))
|
:name (get c "name")))
|
||||||
cal-list))
|
cal-list))
|
||||||
|
|||||||
@@ -1,59 +1,59 @@
|
|||||||
;; Blog card components — pure data, no HTML injection
|
;; 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"
|
(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"
|
(<> (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")
|
(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 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)))))
|
(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)))
|
(p :class "text-sm text-stone-500" (str "Published: " timestamp)))
|
||||||
|
|
||||||
;; Tag components — accept data, not HTML
|
;; 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
|
(if src
|
||||||
(img :src src :alt name :class "h-4 w-4 rounded-full object-cover border border-stone-300 flex-shrink-0")
|
(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)))
|
(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"
|
(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))))
|
(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
|
;; 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)
|
(when (or tags authors)
|
||||||
(div :class "flex flex-row justify-center gap-3"
|
(div :class "flex flex-row justify-center gap-3"
|
||||||
(when tags
|
(when tags
|
||||||
(div :class "mt-4 flex items-center gap-2" (div "in")
|
(div :class "mt-4 flex items-center gap-2" (div "in")
|
||||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
(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)
|
(div)
|
||||||
(when authors
|
(when authors
|
||||||
(div :class "mt-4 flex items-center gap-2" (div "by")
|
(div :class "mt-4 flex items-center gap-2" (div "by")
|
||||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
(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
|
;; Author components
|
||||||
(defcomp ~blog-author-item (&key image name)
|
(defcomp ~cards/author-item (&key image name)
|
||||||
(li :class "flex items-center gap-1"
|
(li :class "flex items-center gap-1"
|
||||||
(when image (img :src image :alt name :class "h-5 w-5 rounded-full object-cover"))
|
(when image (img :src image :alt name :class "h-5 w-5 rounded-full object-cover"))
|
||||||
(span :class "text-stone-700" name)))
|
(span :class "text-stone-700" name)))
|
||||||
|
|
||||||
;; Card — accepts pure data
|
;; Card — accepts pure data
|
||||||
(defcomp ~blog-card (&key slug href hx-select title
|
(defcomp ~cards/index (&key (slug :as string) (href :as string) (hx-select :as string?) (title :as string)
|
||||||
feature-image excerpt
|
(feature-image :as string?) (excerpt :as string?)
|
||||||
status is-draft publish-requested status-timestamp
|
status (is-draft :as boolean) (publish-requested :as boolean) (status-timestamp :as string?)
|
||||||
liked like-url csrf-token
|
(liked :as boolean) (like-url :as string?) (csrf-token :as string?)
|
||||||
has-like
|
(has-like :as boolean)
|
||||||
tags authors widget)
|
(tags :as list?) (authors :as list?) widget)
|
||||||
(article :class "border-b pb-6 last:border-b-0 relative"
|
(article :class "border-b pb-6 last:border-b-0 relative"
|
||||||
(when has-like
|
(when has-like
|
||||||
(~blog-like-button
|
(~cards/like-button
|
||||||
:like-url like-url
|
:like-url like-url
|
||||||
:hx-headers {:X-CSRFToken csrf-token}
|
:hx-headers {:X-CSRFToken csrf-token}
|
||||||
:heart (if liked "❤️" "🤍")))
|
:heart (if liked "❤️" "🤍")))
|
||||||
@@ -63,8 +63,8 @@
|
|||||||
(header :class "mb-2 text-center"
|
(header :class "mb-2 text-center"
|
||||||
(h2 :class "text-4xl font-bold text-stone-900" title)
|
(h2 :class "text-4xl font-bold text-stone-900" title)
|
||||||
(if is-draft
|
(if is-draft
|
||||||
(~blog-draft-status :publish-requested publish-requested :timestamp status-timestamp)
|
(~cards/draft-status :publish-requested publish-requested :timestamp status-timestamp)
|
||||||
(when status-timestamp (~blog-published-status :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 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)))
|
(when excerpt (p :class "text-stone-700 text-lg leading-relaxed text-center" excerpt)))
|
||||||
widget
|
widget
|
||||||
@@ -73,16 +73,16 @@
|
|||||||
(when tags
|
(when tags
|
||||||
(div :class "mt-4 flex items-center gap-2" (div "in")
|
(div :class "mt-4 flex items-center gap-2" (div "in")
|
||||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
(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)
|
(div)
|
||||||
(when authors
|
(when authors
|
||||||
(div :class "mt-4 flex items-center gap-2" (div "by")
|
(div :class "mt-4 flex items-center gap-2" (div "by")
|
||||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
(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
|
(defcomp ~cards/tile (&key (href :as string) (hx-select :as string?) (feature-image :as string?) (title :as string)
|
||||||
is-draft publish-requested status-timestamp
|
(is-draft :as boolean) (publish-requested :as boolean) (status-timestamp :as string?)
|
||||||
excerpt tags authors)
|
(excerpt :as string?) (tags :as list?) (authors :as list?))
|
||||||
(article :class "relative"
|
(article :class "relative"
|
||||||
(a :href href :sx-get href :sx-target "#main-panel"
|
(a :href href :sx-get href :sx-target "#main-panel"
|
||||||
:sx-select (or hx-select "#main-panel") :sx-swap "outerHTML" :sx-push-url "true"
|
:sx-select (or hx-select "#main-panel") :sx-swap "outerHTML" :sx-push-url "true"
|
||||||
@@ -91,33 +91,33 @@
|
|||||||
(div :class "p-3 text-center"
|
(div :class "p-3 text-center"
|
||||||
(h2 :class "text-lg font-bold text-stone-900" title)
|
(h2 :class "text-lg font-bold text-stone-900" title)
|
||||||
(if is-draft
|
(if is-draft
|
||||||
(~blog-draft-status :publish-requested publish-requested :timestamp status-timestamp)
|
(~cards/draft-status :publish-requested publish-requested :timestamp status-timestamp)
|
||||||
(when status-timestamp (~blog-published-status :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 excerpt (p :class "text-stone-700 text-sm leading-relaxed line-clamp-3 mt-1" excerpt))))
|
||||||
(when (or tags authors)
|
(when (or tags authors)
|
||||||
(div :class "flex flex-row justify-center gap-3"
|
(div :class "flex flex-row justify-center gap-3"
|
||||||
(when tags
|
(when tags
|
||||||
(div :class "mt-4 flex items-center gap-2" (div "in")
|
(div :class "mt-4 flex items-center gap-2" (div "in")
|
||||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
(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)
|
(div)
|
||||||
(when authors
|
(when authors
|
||||||
(div :class "mt-4 flex items-center gap-2" (div "by")
|
(div :class "mt-4 flex items-center gap-2" (div "by")
|
||||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
(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)
|
;; 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)
|
(map (lambda (p)
|
||||||
(if (= view "tile")
|
(if (= view "tile")
|
||||||
(~blog-card-tile
|
(~cards/tile
|
||||||
:href (get p "href") :hx-select (get p "hx_select")
|
:href (get p "href") :hx-select (get p "hx_select")
|
||||||
:feature-image (get p "feature_image") :title (get p "title")
|
:feature-image (get p "feature_image") :title (get p "title")
|
||||||
:is-draft (get p "is_draft") :publish-requested (get p "publish_requested")
|
:is-draft (get p "is_draft") :publish-requested (get p "publish_requested")
|
||||||
:status-timestamp (get p "status_timestamp")
|
:status-timestamp (get p "status_timestamp")
|
||||||
:excerpt (get p "excerpt") :tags (get p "tags") :authors (get p "authors"))
|
: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")
|
:slug (get p "slug") :href (get p "href") :hx-select (get p "hx_select")
|
||||||
:title (get p "title") :feature-image (get p "feature_image")
|
:title (get p "title") :feature-image (get p "feature_image")
|
||||||
:excerpt (get p "excerpt") :is-draft (get p "is_draft")
|
:excerpt (get p "excerpt") :is-draft (get p "is_draft")
|
||||||
@@ -131,10 +131,10 @@
|
|||||||
sentinel))
|
sentinel))
|
||||||
|
|
||||||
;; Data-driven page cards list (replaces Python _page_cards_sx loop)
|
;; 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)
|
(map (lambda (pg)
|
||||||
(~blog-page-card
|
(~cards/page-card
|
||||||
:href (get pg "href") :hx-select (get pg "hx_select")
|
:href (get pg "href") :hx-select (get pg "hx_select")
|
||||||
:title (get pg "title")
|
:title (get pg "title")
|
||||||
:has-calendar (get pg "has_calendar") :has-market (get pg "has_market")
|
:has-calendar (get pg "has_calendar") :has-market (get pg "has_market")
|
||||||
@@ -143,21 +143,21 @@
|
|||||||
(or pages (list)))
|
(or pages (list)))
|
||||||
sentinel))
|
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"
|
(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"
|
(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"))
|
(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"
|
(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"))))
|
(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"
|
(article :class "border-b pb-6 last:border-b-0 relative"
|
||||||
(a :href href :sx-get href :sx-target "#main-panel"
|
(a :href href :sx-get href :sx-target "#main-panel"
|
||||||
:sx-select (or hx-select "#main-panel") :sx-swap "outerHTML" :sx-push-url "true"
|
: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"
|
:class "block rounded-xl bg-white shadow hover:shadow-md transition overflow-hidden"
|
||||||
(header :class "mb-2 text-center"
|
(header :class "mb-2 text-center"
|
||||||
(h2 :class "text-4xl font-bold text-stone-900" title)
|
(h2 :class "text-4xl font-bold text-stone-900" title)
|
||||||
(~blog-page-badges :has-calendar has-calendar :has-market has-market)
|
(~cards/page-badges :has-calendar has-calendar :has-market has-market)
|
||||||
(when pub-timestamp (~blog-published-status :timestamp pub-timestamp)))
|
(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 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)))))
|
(when excerpt (p :class "text-stone-700 text-lg leading-relaxed text-center" excerpt)))))
|
||||||
|
|||||||
@@ -1,34 +1,34 @@
|
|||||||
;; Blog post detail components
|
;; 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"
|
(a :href href :sx-get href :sx-target "#main-panel"
|
||||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
: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"
|
: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"))
|
(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"
|
(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")
|
(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"))
|
(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))
|
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"
|
(button :sx-post like-url :sx-swap "outerHTML"
|
||||||
:sx-headers hx-headers :class "cursor-pointer" heart))
|
: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"
|
(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))
|
(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
|
(<> like
|
||||||
excerpt
|
excerpt
|
||||||
(div :class "hidden md:block" at-bar)))
|
(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"
|
(<> (article :class "relative"
|
||||||
draft
|
draft
|
||||||
chrome
|
chrome
|
||||||
@@ -43,34 +43,34 @@
|
|||||||
;; Data-driven composition — replaces _post_main_panel_sx
|
;; Data-driven composition — replaces _post_main_panel_sx
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~blog-post-detail-content (&key slug is-draft publish-requested can-edit edit-href
|
(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 has-user liked like-url csrf
|
(is-page :as boolean) (has-user :as boolean) (liked :as boolean) (like-url :as string?) (csrf :as string?)
|
||||||
custom-excerpt tags authors
|
(custom-excerpt :as string?) (tags :as list?) (authors :as list?)
|
||||||
feature-image html-content sx-content)
|
(feature-image :as string?) (html-content :as string?) (sx-content :as string?))
|
||||||
(let* ((hx-select "#main-panel")
|
(let* ((hx-select "#main-panel")
|
||||||
(draft-sx (when is-draft
|
(draft-sx (when is-draft
|
||||||
(~blog-detail-draft
|
(~detail/draft
|
||||||
:publish-requested publish-requested
|
:publish-requested publish-requested
|
||||||
:edit (when can-edit
|
: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)
|
(chrome-sx (when (not is-page)
|
||||||
(~blog-detail-chrome
|
(~detail/chrome
|
||||||
:like (when has-user
|
:like (when has-user
|
||||||
(~blog-detail-like
|
(~detail/like
|
||||||
:like-url like-url
|
:like-url like-url
|
||||||
:hx-headers {:X-CSRFToken csrf}
|
:hx-headers {:X-CSRFToken csrf}
|
||||||
:heart (if liked "❤️" "🤍")))
|
:heart (if liked "❤️" "🤍")))
|
||||||
:excerpt (when (not (= custom-excerpt ""))
|
:excerpt (when (not (= custom-excerpt ""))
|
||||||
(~blog-detail-excerpt :excerpt custom-excerpt))
|
(~detail/excerpt :excerpt custom-excerpt))
|
||||||
:at-bar (~blog-at-bar :tags tags :authors authors)))))
|
:at-bar (~cards/at-bar :tags tags :authors authors)))))
|
||||||
(~blog-detail-main
|
(~detail/main
|
||||||
:draft draft-sx
|
:draft draft-sx
|
||||||
:chrome chrome-sx
|
:chrome chrome-sx
|
||||||
:feature-image feature-image
|
:feature-image feature-image
|
||||||
:html-content html-content
|
:html-content html-content
|
||||||
:sx-content sx-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)
|
(meta :name "robots" :content robots)
|
||||||
(title page-title)
|
(title page-title)
|
||||||
@@ -86,7 +86,7 @@
|
|||||||
(meta :name "twitter:description" :content desc)
|
(meta :name "twitter:description" :content desc)
|
||||||
(when image (meta :name "twitter:image" :content image))))
|
(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"
|
(article :class "relative"
|
||||||
(if sx-content
|
(if sx-content
|
||||||
(div :class "blog-content p-2" sx-content)
|
(div :class "blog-content p-2" sx-content)
|
||||||
|
|||||||
@@ -1,10 +1,10 @@
|
|||||||
;; Blog editor components
|
;; 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"
|
(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))
|
(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]"
|
(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" :name "csrf_token" :value csrf)
|
||||||
(input :type "hidden" :id "lexical-json-input" :name "lexical" :value "")
|
(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))))
|
: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/
|
;; Edit form — pre-populated version for /<slug>/admin/edit/
|
||||||
(defcomp ~blog-editor-edit-form (&key csrf updated-at title-val excerpt-val
|
(defcomp ~editor/edit-form (&key (csrf :as string) (updated-at :as string) (title-val :as string?) (excerpt-val :as string?)
|
||||||
feature-image feature-image-caption
|
(feature-image :as string?) (feature-image-caption :as string?)
|
||||||
sx-content-val lexical-json
|
(sx-content-val :as string?) (lexical-json :as string?)
|
||||||
has-sx title-placeholder
|
(has-sx :as boolean) (title-placeholder :as string)
|
||||||
status already-emailed
|
(status :as string) (already-emailed :as boolean)
|
||||||
newsletter-options footer-extra)
|
newsletter-options footer-extra)
|
||||||
(let* ((sel-cls "text-[14px] rounded-[4px] border border-stone-200 px-[8px] py-[6px] bg-white text-stone-600")
|
(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")
|
(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)))))
|
(when footer-extra footer-extra)))))
|
||||||
|
|
||||||
;; Publish-mode show/hide script for edit form
|
;; Publish-mode show/hide script for edit form
|
||||||
(defcomp ~blog-editor-publish-js (&key already-emailed)
|
(defcomp ~editor/publish-js (&key already-emailed)
|
||||||
(script
|
(script
|
||||||
"(function() {"
|
"(function() {"
|
||||||
" var statusSel = document.getElementById('status-select');"
|
" var statusSel = document.getElementById('status-select');"
|
||||||
@@ -153,20 +153,20 @@
|
|||||||
" sync();"
|
" sync();"
|
||||||
"})();"))
|
"})();"))
|
||||||
|
|
||||||
(defcomp ~blog-editor-styles (&key css-href)
|
(defcomp ~editor/styles (&key (css-href :as string))
|
||||||
(<> (link :rel "stylesheet" :href css-href)
|
(<> (link :rel "stylesheet" :href css-href)
|
||||||
(style
|
(style
|
||||||
"#lexical-editor { display: flow-root; }"
|
"#lexical-editor { display: flow-root; }"
|
||||||
"#lexical-editor [data-kg-card=\"html\"] * { float: none !important; }"
|
"#lexical-editor [data-kg-card=\"html\"] * { float: none !important; }"
|
||||||
"#lexical-editor [data-kg-card=\"html\"] table { width: 100% !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)
|
(<> (script :src js-src)
|
||||||
(when sx-editor-js-src (script :src sx-editor-js-src))
|
(when sx-editor-js-src (script :src sx-editor-js-src))
|
||||||
(script init-js)))
|
(script init-js)))
|
||||||
|
|
||||||
;; SX editor styles — comprehensive CSS for the Koenig-style block editor
|
;; SX editor styles — comprehensive CSS for the Koenig-style block editor
|
||||||
(defcomp ~sx-editor-styles ()
|
(defcomp ~editor/sx-editor-styles ()
|
||||||
(style
|
(style
|
||||||
;; Editor container
|
;; Editor container
|
||||||
".sx-editor { position: relative; font-size: 18px; line-height: 1.6; font-family: Georgia, 'Times New Roman', serif; color: #1c1917; }"
|
".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)
|
;; 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
|
css-href js-src sx-editor-js-src init-js
|
||||||
save-error)
|
save-error)
|
||||||
(~blog-editor-panel :parts
|
(~layouts/editor-panel :parts
|
||||||
(<>
|
(<>
|
||||||
(when save-error (~blog-editor-error :error save-error))
|
(when save-error (~editor/error :error save-error))
|
||||||
(~blog-editor-form :csrf csrf :title-placeholder title-placeholder
|
(~editor/form :csrf csrf :title-placeholder title-placeholder
|
||||||
:create-label create-label)
|
:create-label create-label)
|
||||||
(~blog-editor-styles :css-href css-href)
|
(~editor/styles :css-href css-href)
|
||||||
(~sx-editor-styles)
|
(~editor/sx-editor-styles)
|
||||||
(~blog-editor-scripts :js-src js-src :sx-editor-js-src sx-editor-js-src
|
(~editor/scripts :js-src js-src :sx-editor-js-src sx-editor-js-src
|
||||||
:init-js init-js))))
|
:init-js init-js))))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Edit content composition — replaces _h_post_edit_content (existing post)
|
;; 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
|
feature-image feature-image-caption
|
||||||
sx-content-val lexical-json has-sx
|
sx-content-val lexical-json has-sx
|
||||||
title-placeholder status already-emailed
|
title-placeholder status already-emailed
|
||||||
newsletter-options footer-extra
|
newsletter-options footer-extra
|
||||||
css-href js-src sx-editor-js-src init-js
|
css-href js-src sx-editor-js-src init-js
|
||||||
save-error)
|
save-error)
|
||||||
(~blog-editor-panel :parts
|
(~layouts/editor-panel :parts
|
||||||
(<>
|
(<>
|
||||||
(when save-error (~blog-editor-error :error save-error))
|
(when save-error (~editor/error :error save-error))
|
||||||
(~blog-editor-edit-form
|
(~editor/edit-form
|
||||||
:csrf csrf :updated-at updated-at
|
:csrf csrf :updated-at updated-at
|
||||||
:title-val title-val :excerpt-val excerpt-val
|
:title-val title-val :excerpt-val excerpt-val
|
||||||
:feature-image feature-image :feature-image-caption feature-image-caption
|
:feature-image feature-image :feature-image-caption feature-image-caption
|
||||||
@@ -343,8 +343,8 @@
|
|||||||
:has-sx has-sx :title-placeholder title-placeholder
|
:has-sx has-sx :title-placeholder title-placeholder
|
||||||
:status status :already-emailed already-emailed
|
:status status :already-emailed already-emailed
|
||||||
:newsletter-options newsletter-options :footer-extra footer-extra)
|
:newsletter-options newsletter-options :footer-extra footer-extra)
|
||||||
(~blog-editor-publish-js :already-emailed already-emailed)
|
(~editor/publish-js :already-emailed already-emailed)
|
||||||
(~blog-editor-styles :css-href css-href)
|
(~editor/styles :css-href css-href)
|
||||||
(~sx-editor-styles)
|
(~editor/sx-editor-styles)
|
||||||
(~blog-editor-scripts :js-src js-src :sx-editor-js-src sx-editor-js-src
|
(~editor/scripts :js-src js-src :sx-editor-js-src sx-editor-js-src
|
||||||
:init-js init-js))))
|
:init-js init-js))))
|
||||||
|
|||||||
@@ -1,37 +1,37 @@
|
|||||||
;; Blog filter components
|
;; 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"
|
(a :href href :sx-get href :sx-target "#main-panel"
|
||||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||||
:class btn-class :title title (i :class icon-class) label))
|
: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"
|
(a :href href :sx-get href :sx-target "#main-panel"
|
||||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
: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 "
|
: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)))
|
(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"
|
(a :href href :sx-get href :sx-target "#main-panel"
|
||||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
: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 "
|
: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)))
|
(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))
|
(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)
|
(li (a :class (str "px-3 py-1 rounded border " cls)
|
||||||
:sx-get "?page=1" :sx-target "#main-panel" :sx-select hx-select
|
:sx-get "?page=1" :sx-target "#main-panel" :sx-select hx-select
|
||||||
:sx-swap "outerHTML" :sx-push-url "true" "Any Topic")))
|
: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"))
|
(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))
|
(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)
|
(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-get hx-get :sx-target "#main-panel" :sx-select hx-select
|
||||||
:sx-swap "outerHTML" :sx-push-url "true"
|
:sx-swap "outerHTML" :sx-push-url "true"
|
||||||
@@ -40,19 +40,19 @@
|
|||||||
(span :class "flex-1")
|
(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))))
|
(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"
|
(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)))
|
(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)
|
(li (a :class (str "px-3 py-1 rounded " cls)
|
||||||
:sx-get "?page=1" :sx-target "#main-panel" :sx-select hx-select
|
:sx-get "?page=1" :sx-target "#main-panel" :sx-select hx-select
|
||||||
:sx-swap "outerHTML" :sx-push-url "true" "Any author")))
|
: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"))
|
(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)
|
(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-get hx-get :sx-target "#main-panel" :sx-select hx-select
|
||||||
:sx-swap "outerHTML" :sx-push-url "true"
|
:sx-swap "outerHTML" :sx-push-url "true"
|
||||||
@@ -61,41 +61,41 @@
|
|||||||
(span :class "flex-1")
|
(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))))
|
(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))
|
(span :class "text-sm text-stone-600" text))
|
||||||
|
|
||||||
;; Data-driven tag groups filter (replaces Python _tag_groups_filter_sx loop)
|
;; 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))))
|
(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")))
|
(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 (<>
|
: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)
|
(map (lambda (g)
|
||||||
(let* ((slug (get g "slug"))
|
(let* ((slug (get g "slug"))
|
||||||
(name (get g "name"))
|
(name (get g "name"))
|
||||||
(is-on (contains? selected-groups slug))
|
(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"))
|
(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")
|
(icon (if (get g "feature_image")
|
||||||
(~blog-filter-group-icon-image :src (get g "feature_image") :name name)
|
(~filters/group-icon-image :src (get g "feature_image") :name name)
|
||||||
(~blog-filter-group-icon-color :style (get g "style") :initial (get g "initial")))))
|
(~filters/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-li :cls cls :hx-get (str "?group=" slug "&page=1") :hx-select hx-select
|
||||||
:icon icon :name name :count (get g "count"))))
|
:icon icon :name name :count (get g "count"))))
|
||||||
(or groups (list)))))))
|
(or groups (list)))))))
|
||||||
|
|
||||||
;; Data-driven authors filter (replaces Python _authors_filter_sx loop)
|
;; 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))))
|
(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")))
|
(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 (<>
|
: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)
|
(map (lambda (a)
|
||||||
(let* ((slug (get a "slug"))
|
(let* ((slug (get a "slug"))
|
||||||
(is-on (contains? selected-authors 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"))
|
(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")
|
(icon (when (get a "profile_image")
|
||||||
(~blog-filter-author-icon :src (get a "profile_image") :name (get a "name")))))
|
(~filters/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-li :cls cls :hx-get (str "?author=" slug "&page=1") :hx-select hx-select
|
||||||
:icon icon :name (get a "name") :count (get a "count"))))
|
:icon icon :name (get a "name") :count (get a "count"))))
|
||||||
(or authors (list)))))))
|
(or authors (list)))))))
|
||||||
|
|||||||
@@ -11,7 +11,7 @@
|
|||||||
(let ((post (query "blog" "post-by-slug" :slug (trim s))))
|
(let ((post (query "blog" "post-by-slug" :slug (trim s))))
|
||||||
(when post
|
(when post
|
||||||
(<> (str "<!-- fragment:" (trim s) " -->")
|
(<> (str "<!-- fragment:" (trim s) " -->")
|
||||||
(~link-card
|
(~shared:fragments/link-card
|
||||||
:link (app-url "blog" (str "/" (get post "slug") "/"))
|
:link (app-url "blog" (str "/" (get post "slug") "/"))
|
||||||
:title (get post "title")
|
:title (get post "title")
|
||||||
:image (get post "feature_image")
|
:image (get post "feature_image")
|
||||||
@@ -22,7 +22,7 @@
|
|||||||
(when slug
|
(when slug
|
||||||
(let ((post (query "blog" "post-by-slug" :slug slug)))
|
(let ((post (query "blog" "post-by-slug" :slug slug)))
|
||||||
(when post
|
(when post
|
||||||
(~link-card
|
(~shared:fragments/link-card
|
||||||
:link (app-url "blog" (str "/" (get post "slug") "/"))
|
:link (app-url "blog" (str "/" (get post "slug") "/"))
|
||||||
:title (get post "title")
|
:title (get post "title")
|
||||||
:image (get post "feature_image")
|
:image (get post "feature_image")
|
||||||
|
|||||||
@@ -30,25 +30,25 @@
|
|||||||
(app-url "blog" (str "/" item-slug "/"))))
|
(app-url "blog" (str "/" item-slug "/"))))
|
||||||
(selected (or (= item-slug (or first-seg ""))
|
(selected (or (= item-slug (or first-seg ""))
|
||||||
(= item-slug app))))
|
(= item-slug app))))
|
||||||
(~blog-nav-item-link
|
(~shared:nav/blog-nav-item-link
|
||||||
:href href
|
:href href
|
||||||
:hx-get href
|
:hx-get href
|
||||||
:selected (if selected "true" "false")
|
:selected (if selected "true" "false")
|
||||||
:nav-cls nav-cls
|
:nav-cls nav-cls
|
||||||
:img (~img-or-placeholder
|
:img (~shared:misc/img-or-placeholder
|
||||||
:src (get item "feature_image")
|
:src (get item "feature_image")
|
||||||
:alt (or (get item "label") item-slug)
|
:alt (or (get item "label") item-slug)
|
||||||
:size-cls "w-8 h-8 rounded-full object-cover flex-shrink-0")
|
:size-cls "w-8 h-8 rounded-full object-cover flex-shrink-0")
|
||||||
:label (or (get item "label") item-slug)))) items)
|
:label (or (get item "label") item-slug)))) items)
|
||||||
|
|
||||||
;; Hardcoded artdag link
|
;; Hardcoded artdag link
|
||||||
(~blog-nav-item-link
|
(~shared:nav/blog-nav-item-link
|
||||||
:href (app-url "artdag" "/")
|
:href (app-url "artdag" "/")
|
||||||
:hx-get (app-url "artdag" "/")
|
:hx-get (app-url "artdag" "/")
|
||||||
:selected (if (or (= "artdag" (or first-seg ""))
|
:selected (if (or (= "artdag" (or first-seg ""))
|
||||||
(= "artdag" app)) "true" "false")
|
(= "artdag" app)) "true" "false")
|
||||||
:nav-cls nav-cls
|
:nav-cls nav-cls
|
||||||
:img (~img-or-placeholder
|
:img (~shared:misc/img-or-placeholder
|
||||||
:src nil :alt "art-dag"
|
:src nil :alt "art-dag"
|
||||||
:size-cls "w-8 h-8 rounded-full object-cover flex-shrink-0")
|
:size-cls "w-8 h-8 rounded-full object-cover flex-shrink-0")
|
||||||
:label "art-dag")))
|
:label "art-dag")))
|
||||||
@@ -69,8 +69,8 @@
|
|||||||
(right-hs (str "on click set #" cid ".scrollLeft to #" cid ".scrollLeft + 200")))
|
(right-hs (str "on click set #" cid ".scrollLeft to #" cid ".scrollLeft + 200")))
|
||||||
|
|
||||||
(if (empty? items)
|
(if (empty? items)
|
||||||
(~blog-nav-empty :wrapper-id "menu-items-nav-wrapper")
|
(~shared:nav/blog-nav-empty :wrapper-id "menu-items-nav-wrapper")
|
||||||
(~scroll-nav-wrapper
|
(~shared:misc/scroll-nav-wrapper
|
||||||
:wrapper-id "menu-items-nav-wrapper"
|
:wrapper-id "menu-items-nav-wrapper"
|
||||||
:container-id cid
|
:container-id cid
|
||||||
:arrow-cls arrow-cls
|
:arrow-cls arrow-cls
|
||||||
|
|||||||
@@ -1,21 +1,21 @@
|
|||||||
;; Blog header components
|
;; 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"
|
(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))
|
: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"))
|
(<> (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"
|
(div :class "relative nav-group"
|
||||||
(a :href href
|
(a :href href
|
||||||
:aria-selected (when is-selected "true")
|
: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 ""))
|
: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)))
|
label)))
|
||||||
|
|
||||||
(defcomp ~blog-sub-settings-label (&key icon label)
|
(defcomp ~header/sub-settings-label (&key icon label)
|
||||||
(<> (i :class icon :aria-hidden "true") " " 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)))
|
(<> (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
|
;; 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."))
|
(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"
|
(div :class "flex justify-center gap-1 px-3 pt-3"
|
||||||
(a :href posts-href :sx-get posts-href :sx-target "#main-panel"
|
(a :href posts-href :sx-get posts-href :sx-target "#main-panel"
|
||||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
: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"
|
: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")))
|
: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
|
(<> tabs
|
||||||
(div :class "max-w-full px-3 py-3 space-y-3" cards)
|
(div :class "max-w-full px-3 py-3 space-y-3" cards)
|
||||||
(div :class "pb-8")))
|
(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
|
(<> tabs
|
||||||
toggle
|
toggle
|
||||||
(div :class grid-cls cards)
|
(div :class grid-cls cards)
|
||||||
(div :class "pb-8")))
|
(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
|
(<> search
|
||||||
action-buttons
|
action-buttons
|
||||||
(div :id "category-summary-desktop" :hxx-swap-oob "outerHTML"
|
(div :id "category-summary-desktop" :hxx-swap-oob "outerHTML"
|
||||||
@@ -36,12 +36,12 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
;; Helper: CSS class for filter item based on selection state
|
;; 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
|
;; Returns nothing — use inline (if is-on ...) instead
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
;; Blog index main content — replaces _blog_main_panel_sx
|
;; 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)
|
current-local-href hx-select blog-url-base)
|
||||||
(let* ((posts-href (str blog-url-base "/index"))
|
(let* ((posts-href (str blog-url-base "/index"))
|
||||||
(pages-href (str posts-href "?type=pages"))
|
(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")))
|
"bg-stone-700 text-white" "bg-stone-100 text-stone-600 hover:bg-stone-200")))
|
||||||
(if (= content-type "pages")
|
(if (= content-type "pages")
|
||||||
;; Pages listing
|
;; Pages listing
|
||||||
(~blog-main-panel-pages
|
(~index/main-panel-pages
|
||||||
:tabs (~blog-content-type-tabs
|
:tabs (~index/content-type-tabs
|
||||||
:posts-href posts-href :pages-href pages-href
|
:posts-href posts-href :pages-href pages-href
|
||||||
:hx-select hx-select :posts-cls posts-cls :pages-cls pages-cls)
|
:hx-select hx-select :posts-cls posts-cls :pages-cls pages-cls)
|
||||||
:cards (<>
|
:cards (<>
|
||||||
(map (lambda (card)
|
(map (lambda (card)
|
||||||
(~blog-page-card
|
(~cards/page-card
|
||||||
:href (get card "href") :hx-select hx-select
|
:href (get card "href") :hx-select hx-select
|
||||||
:title (get card "title")
|
:title (get card "title")
|
||||||
:has-calendar (get card "has_calendar")
|
:has-calendar (get card "has_calendar")
|
||||||
@@ -67,14 +67,14 @@
|
|||||||
:excerpt (get card "excerpt")))
|
:excerpt (get card "excerpt")))
|
||||||
(or cards (list)))
|
(or cards (list)))
|
||||||
(if (< page total-pages)
|
(if (< page total-pages)
|
||||||
(~sentinel-simple
|
(~shared:misc/sentinel-simple
|
||||||
:id (str "sentinel-" page "-d")
|
:id (str "sentinel-" page "-d")
|
||||||
:next-url (str current-local-href
|
:next-url (str current-local-href
|
||||||
(if (contains? current-local-href "?") "&" "?")
|
(if (contains? current-local-href "?") "&" "?")
|
||||||
"page=" (+ page 1)))
|
"page=" (+ page 1)))
|
||||||
(if (not (empty? (or cards (list))))
|
(if (not (empty? (or cards (list))))
|
||||||
(~end-of-results)
|
(~shared:misc/end-of-results)
|
||||||
(~blog-no-pages)))))
|
(~index/no-pages)))))
|
||||||
;; Posts listing
|
;; Posts listing
|
||||||
(let* ((grid-cls (if (= view "tile")
|
(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"
|
"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")
|
(tile-cls (if (= view "tile")
|
||||||
"bg-stone-200 text-stone-800"
|
"bg-stone-200 text-stone-800"
|
||||||
"text-stone-400 hover:text-stone-600")))
|
"text-stone-400 hover:text-stone-600")))
|
||||||
(~blog-main-panel-posts
|
(~index/main-panel-posts
|
||||||
:tabs (~blog-content-type-tabs
|
:tabs (~index/content-type-tabs
|
||||||
:posts-href posts-href :pages-href pages-href
|
:posts-href posts-href :pages-href pages-href
|
||||||
:hx-select hx-select :posts-cls posts-cls :pages-cls pages-cls)
|
: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-href list-href :tile-href tile-href :hx-select hx-select
|
||||||
:list-cls list-cls :tile-cls tile-cls :storage-key "blog_view"
|
: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
|
:grid-cls grid-cls
|
||||||
:cards (<>
|
:cards (<>
|
||||||
(map (lambda (card)
|
(map (lambda (card)
|
||||||
(if (= view "tile")
|
(if (= view "tile")
|
||||||
(~blog-card-tile
|
(~cards/tile
|
||||||
:href (get card "href") :hx-select hx-select
|
:href (get card "href") :hx-select hx-select
|
||||||
:feature-image (get card "feature_image")
|
:feature-image (get card "feature_image")
|
||||||
:title (get card "title") :is-draft (get card "is_draft")
|
:title (get card "title") :is-draft (get card "is_draft")
|
||||||
@@ -108,7 +108,7 @@
|
|||||||
:status-timestamp (get card "status_timestamp")
|
:status-timestamp (get card "status_timestamp")
|
||||||
:excerpt (get card "excerpt")
|
:excerpt (get card "excerpt")
|
||||||
:tags (get card "tags") :authors (get card "authors"))
|
:tags (get card "tags") :authors (get card "authors"))
|
||||||
(~blog-card
|
(~cards/index
|
||||||
:slug (get card "slug") :href (get card "href") :hx-select hx-select
|
:slug (get card "slug") :href (get card "href") :hx-select hx-select
|
||||||
:title (get card "title") :feature-image (get card "feature_image")
|
:title (get card "title") :feature-image (get card "feature_image")
|
||||||
:excerpt (get card "excerpt") :is-draft (get card "is_draft")
|
:excerpt (get card "excerpt") :is-draft (get card "is_draft")
|
||||||
@@ -119,52 +119,52 @@
|
|||||||
:tags (get card "tags") :authors (get card "authors")
|
:tags (get card "tags") :authors (get card "authors")
|
||||||
:widget (get card "widget"))))
|
:widget (get card "widget"))))
|
||||||
(or cards (list)))
|
(or cards (list)))
|
||||||
(~blog-index-sentinel
|
(~index/sentinel
|
||||||
:page page :total-pages total-pages
|
:page page :total-pages total-pages
|
||||||
:current-local-href current-local-href)))))))
|
:current-local-href current-local-href)))))))
|
||||||
|
|
||||||
;; Sentinel for blog index infinite scroll
|
;; 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)
|
(when (< page total-pages)
|
||||||
(let* ((next-url (str current-local-href "?page=" (+ page 1))))
|
(let* ((next-url (str current-local-href "?page=" (+ page 1))))
|
||||||
(~sentinel-desktop
|
(~shared:misc/sentinel-desktop
|
||||||
:id (str "sentinel-" page "-d")
|
:id (str "sentinel-" page "-d")
|
||||||
:next-url next-url
|
: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()"))))
|
: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
|
;; 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)
|
new-post-href new-page-href current-local-href)
|
||||||
(~blog-action-buttons-wrapper
|
(~filters/action-buttons-wrapper
|
||||||
:inner (<>
|
:inner (<>
|
||||||
(when is-admin
|
(when is-admin
|
||||||
(<>
|
(<>
|
||||||
(~blog-action-button
|
(~filters/action-button
|
||||||
:href new-post-href :hx-select hx-select
|
: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"
|
: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")
|
: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
|
: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"
|
: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")))
|
:title "New Page" :icon-class "fa fa-plus mr-1" :label " New Page")))
|
||||||
(when (and has-user (or draft-count drafts))
|
(when (and has-user (or draft-count drafts))
|
||||||
(if drafts
|
(if drafts
|
||||||
(~blog-drafts-button
|
(~filters/drafts-button
|
||||||
:href current-local-href :hx-select hx-select
|
: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"
|
: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))
|
:title "Hide Drafts" :label " Drafts " :draft-count (str draft-count))
|
||||||
(let* ((on-href (str current-local-href
|
(let* ((on-href (str current-local-href
|
||||||
(if (contains? current-local-href "?") "&" "?") "drafts=1")))
|
(if (contains? current-local-href "?") "&" "?") "drafts=1")))
|
||||||
(~blog-drafts-button-amber
|
(~filters/drafts-button-amber
|
||||||
:href on-href :hx-select hx-select
|
: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"
|
: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))))))))
|
:title "Show Drafts" :label " Drafts " :draft-count (str draft-count))))))))
|
||||||
|
|
||||||
;; Tag groups filter — replaces _tag_groups_filter_sx
|
;; Tag groups filter — replaces _tag_groups_filter_sx
|
||||||
(defcomp ~blog-index-tag-groups-filter (&key tag-groups is-any-group hx-select)
|
(defcomp ~index/tag-groups-filter (&key tag-groups is-any-group hx-select)
|
||||||
(~blog-filter-nav
|
(~filters/nav
|
||||||
:items (<>
|
:items (<>
|
||||||
(~blog-filter-any-topic
|
(~filters/any-topic
|
||||||
:cls (if is-any-group
|
:cls (if is-any-group
|
||||||
"bg-stone-900 text-white border-stone-900"
|
"bg-stone-900 text-white border-stone-900"
|
||||||
"bg-white text-stone-600 border-stone-300 hover:bg-stone-50")
|
"bg-white text-stone-600 border-stone-300 hover:bg-stone-50")
|
||||||
@@ -178,23 +178,23 @@
|
|||||||
(colour (get grp "colour"))
|
(colour (get grp "colour"))
|
||||||
(name (get grp "name"))
|
(name (get grp "name"))
|
||||||
(icon (if fi
|
(icon (if fi
|
||||||
(~blog-filter-group-icon-image :src fi :name name)
|
(~filters/group-icon-image :src fi :name name)
|
||||||
(~blog-filter-group-icon-color
|
(~filters/group-icon-color
|
||||||
:style (if colour
|
:style (if colour
|
||||||
(str "background-color: " colour "; color: white;")
|
(str "background-color: " colour "; color: white;")
|
||||||
"background-color: #e7e5e4; color: #57534e;")
|
"background-color: #e7e5e4; color: #57534e;")
|
||||||
:initial (slice (or name "?") 0 1)))))
|
:initial (slice (or name "?") 0 1)))))
|
||||||
(~blog-filter-group-li
|
(~filters/group-li
|
||||||
:cls cls :hx-get (str "?group=" (get grp "slug") "&page=1")
|
:cls cls :hx-get (str "?group=" (get grp "slug") "&page=1")
|
||||||
:hx-select hx-select :icon icon
|
:hx-select hx-select :icon icon
|
||||||
:name name :count (str (get grp "post_count")))))
|
:name name :count (str (get grp "post_count")))))
|
||||||
(or tag-groups (list))))))
|
(or tag-groups (list))))))
|
||||||
|
|
||||||
;; Authors filter — replaces _authors_filter_sx
|
;; Authors filter — replaces _authors_filter_sx
|
||||||
(defcomp ~blog-index-authors-filter (&key authors is-any-author hx-select)
|
(defcomp ~index/authors-filter (&key authors is-any-author hx-select)
|
||||||
(~blog-filter-nav
|
(~filters/nav
|
||||||
:items (<>
|
:items (<>
|
||||||
(~blog-filter-any-author
|
(~filters/any-author
|
||||||
:cls (if is-any-author
|
:cls (if is-any-author
|
||||||
"bg-stone-900 text-white border-stone-900"
|
"bg-stone-900 text-white border-stone-900"
|
||||||
"bg-white text-stone-600 border-stone-300 hover:bg-stone-50")
|
"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-stone-900 text-white border-stone-900"
|
||||||
"bg-white text-stone-600 border-stone-300 hover:bg-stone-50"))
|
"bg-white text-stone-600 border-stone-300 hover:bg-stone-50"))
|
||||||
(img (get a "profile_image")))
|
(img (get a "profile_image")))
|
||||||
(~blog-filter-author-li
|
(~filters/author-li
|
||||||
:cls cls :hx-get (str "?author=" (get a "slug") "&page=1")
|
:cls cls :hx-get (str "?author=" (get a "slug") "&page=1")
|
||||||
:hx-select hx-select
|
: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")
|
:name (get a "name")
|
||||||
:count (str (get a "published_post_count")))))
|
:count (str (get a "published_post_count")))))
|
||||||
(or authors (list))))))
|
(or authors (list))))))
|
||||||
|
|
||||||
;; Blog index aside — replaces _blog_aside_sx
|
;; 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
|
new-post-href new-page-href current-local-href
|
||||||
tag-groups authors is-any-group is-any-author)
|
tag-groups authors is-any-group is-any-author)
|
||||||
(~blog-aside
|
(~index/aside
|
||||||
:search (~search-desktop)
|
:search (~shared:controls/search-desktop)
|
||||||
:action-buttons (~blog-index-actions
|
:action-buttons (~index/actions
|
||||||
:is-admin is-admin :has-user has-user :hx-select hx-select
|
:is-admin is-admin :has-user has-user :hx-select hx-select
|
||||||
:draft-count draft-count :drafts drafts
|
:draft-count draft-count :drafts drafts
|
||||||
:new-post-href new-post-href :new-page-href new-page-href
|
:new-post-href new-post-href :new-page-href new-page-href
|
||||||
:current-local-href current-local-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)
|
: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)))
|
:authors authors :is-any-author is-any-author :hx-select hx-select)))
|
||||||
|
|
||||||
;; Blog index mobile filter — replaces _blog_filter_sx
|
;; 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
|
new-post-href new-page-href current-local-href
|
||||||
tag-groups authors is-any-group is-any-author
|
tag-groups authors is-any-group is-any-author
|
||||||
tg-summary au-summary)
|
tg-summary au-summary)
|
||||||
(~mobile-filter
|
(~shared:controls/mobile-filter
|
||||||
:filter-summary (<>
|
:filter-summary (<>
|
||||||
(~search-mobile)
|
(~shared:controls/search-mobile)
|
||||||
(when (not (= tg-summary ""))
|
(when (not (= tg-summary ""))
|
||||||
(~blog-filter-summary :text tg-summary))
|
(~filters/summary :text tg-summary))
|
||||||
(when (not (= au-summary ""))
|
(when (not (= au-summary ""))
|
||||||
(~blog-filter-summary :text au-summary)))
|
(~filters/summary :text au-summary)))
|
||||||
:action-buttons (~blog-index-actions
|
:action-buttons (~index/actions
|
||||||
:is-admin is-admin :has-user has-user :hx-select hx-select
|
:is-admin is-admin :has-user has-user :hx-select hx-select
|
||||||
:draft-count draft-count :drafts drafts
|
:draft-count draft-count :drafts drafts
|
||||||
:new-post-href new-post-href :new-page-href new-page-href
|
:new-post-href new-post-href :new-page-href new-page-href
|
||||||
:current-local-href current-local-href)
|
:current-local-href current-local-href)
|
||||||
:filter-details (<>
|
: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)
|
: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))))
|
:authors authors :is-any-author is-any-author :hx-select hx-select))))
|
||||||
|
|||||||
@@ -7,7 +7,7 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Image card
|
;; 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"
|
(figure :class (str "kg-card kg-image-card"
|
||||||
(if (= width "wide") " kg-width-wide"
|
(if (= width "wide") " kg-width-wide"
|
||||||
(if (= width "full") " kg-width-full" "")))
|
(if (= width "full") " kg-width-full" "")))
|
||||||
@@ -19,7 +19,7 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Gallery card
|
;; 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"
|
(figure :class "kg-card kg-gallery-card kg-width-wide"
|
||||||
(div :class "kg-gallery-container"
|
(div :class "kg-gallery-container"
|
||||||
(map (lambda (row)
|
(map (lambda (row)
|
||||||
@@ -36,19 +36,19 @@
|
|||||||
;; HTML card — wraps user-pasted HTML so the editor can identify the block.
|
;; HTML card — wraps user-pasted HTML so the editor can identify the block.
|
||||||
;; Content is native sx children (no longer an opaque HTML string).
|
;; 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))
|
(div :class "kg-card kg-html-card" children))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Markdown card — rendered markdown content, editor can identify the block.
|
;; 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))
|
(div :class "kg-card kg-md-card" children))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Embed card
|
;; 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"
|
(figure :class "kg-card kg-embed-card"
|
||||||
(~rich-text :html html)
|
(~rich-text :html html)
|
||||||
(when caption (figcaption caption))))
|
(when caption (figcaption caption))))
|
||||||
@@ -56,7 +56,7 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Bookmark card
|
;; 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"
|
(figure :class "kg-card kg-bookmark-card"
|
||||||
(a :class "kg-bookmark-container" :href url
|
(a :class "kg-bookmark-container" :href url
|
||||||
(div :class "kg-bookmark-content"
|
(div :class "kg-bookmark-content"
|
||||||
@@ -75,7 +75,7 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Callout card
|
;; 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"))
|
(div :class (str "kg-card kg-callout-card kg-callout-card-" (or color "grey"))
|
||||||
(when emoji (div :class "kg-callout-emoji" emoji))
|
(when emoji (div :class "kg-callout-emoji" emoji))
|
||||||
(div :class "kg-callout-text" (or content ""))))
|
(div :class "kg-callout-text" (or content ""))))
|
||||||
@@ -83,14 +83,14 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Button card
|
;; 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"))
|
(div :class (str "kg-card kg-button-card kg-align-" (or alignment "center"))
|
||||||
(a :href url :class "kg-btn kg-btn-accent" (or text ""))))
|
(a :href url :class "kg-btn kg-btn-accent" (or text ""))))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Toggle card (accordion)
|
;; 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-card kg-toggle-card" :data-kg-toggle-state "close"
|
||||||
(div :class "kg-toggle-heading"
|
(div :class "kg-toggle-heading"
|
||||||
(h4 :class "kg-toggle-heading-text" (or heading ""))
|
(h4 :class "kg-toggle-heading-text" (or heading ""))
|
||||||
@@ -101,7 +101,7 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Audio card
|
;; 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"
|
(div :class "kg-card kg-audio-card"
|
||||||
(if thumbnail
|
(if thumbnail
|
||||||
(img :src thumbnail :alt "audio-thumbnail" :class "kg-audio-thumbnail")
|
(img :src thumbnail :alt "audio-thumbnail" :class "kg-audio-thumbnail")
|
||||||
@@ -124,7 +124,7 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Video card
|
;; 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"
|
(figure :class (str "kg-card kg-video-card"
|
||||||
(if (= width "wide") " kg-width-wide"
|
(if (= width "wide") " kg-width-wide"
|
||||||
(if (= width "full") " kg-width-full" "")))
|
(if (= width "full") " kg-width-full" "")))
|
||||||
@@ -136,7 +136,7 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; File card
|
;; 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"
|
(div :class "kg-card kg-file-card"
|
||||||
(a :class "kg-file-card-container" :href src :download (or filename "")
|
(a :class "kg-file-card-container" :href src :download (or filename "")
|
||||||
(div :class "kg-file-card-contents"
|
(div :class "kg-file-card-contents"
|
||||||
@@ -149,5 +149,5 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Paywall marker
|
;; Paywall marker
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
(defcomp ~kg-paywall ()
|
(defcomp ~kg_cards/kg-paywall ()
|
||||||
(~rich-text :html "<!--members-only-->"))
|
(~rich-text :html "<!--members-only-->"))
|
||||||
|
|||||||
@@ -3,8 +3,8 @@
|
|||||||
|
|
||||||
;; --- Blog header (invisible row for blog-header-child swap target) ---
|
;; --- Blog header (invisible row for blog-header-child swap target) ---
|
||||||
|
|
||||||
(defcomp ~blog-header (&key oob)
|
(defcomp ~layouts/header (&key oob)
|
||||||
(~menu-row-sx :id "blog-row" :level 1
|
(~shared:layout/menu-row-sx :id "blog-row" :level 1
|
||||||
:link-label-content (div)
|
:link-label-content (div)
|
||||||
:child-id "blog-header-child" :oob oob))
|
:child-id "blog-header-child" :oob oob))
|
||||||
|
|
||||||
@@ -12,10 +12,10 @@
|
|||||||
|
|
||||||
(defmacro ~blog-settings-header-auto (oob)
|
(defmacro ~blog-settings-header-auto (oob)
|
||||||
(quasiquote
|
(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-href (url-for "settings.defpage_settings_home")
|
||||||
:link-label-content (~blog-admin-label)
|
:link-label-content (~header/admin-label)
|
||||||
:nav (~blog-settings-nav)
|
:nav (~layouts/settings-nav)
|
||||||
:child-id "root-settings-header-child"
|
:child-id "root-settings-header-child"
|
||||||
:oob (unquote oob))))
|
:oob (unquote oob))))
|
||||||
|
|
||||||
@@ -23,9 +23,9 @@
|
|||||||
|
|
||||||
(defmacro ~blog-sub-settings-header-auto (row-id child-id endpoint icon label oob)
|
(defmacro ~blog-sub-settings-header-auto (row-id child-id endpoint icon label oob)
|
||||||
(quasiquote
|
(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-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))
|
:icon (str "fa fa-" (unquote icon))
|
||||||
:label (unquote label))
|
:label (unquote label))
|
||||||
:child-id (unquote child-id)
|
:child-id (unquote child-id)
|
||||||
@@ -35,47 +35,47 @@
|
|||||||
;; Blog layout (root + blog header)
|
;; Blog layout (root + blog header)
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~blog-layout-full ()
|
(defcomp ~layouts/full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~blog-header)))
|
(~layouts/header)))
|
||||||
|
|
||||||
(defcomp ~blog-layout-oob ()
|
(defcomp ~layouts/oob ()
|
||||||
(<> (~blog-header :oob true)
|
(<> (~layouts/header :oob true)
|
||||||
(~clear-oob-div :id "blog-header-child")
|
(~shared:layout/clear-oob-div :id "blog-header-child")
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Settings layout (root + settings header)
|
;; Settings layout (root + settings header)
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~blog-settings-layout-full ()
|
(defcomp ~layouts/settings-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~blog-settings-header-auto)))
|
(~blog-settings-header-auto)))
|
||||||
|
|
||||||
(defcomp ~blog-settings-layout-oob ()
|
(defcomp ~layouts/settings-layout-oob ()
|
||||||
(<> (~blog-settings-header-auto true)
|
(<> (~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)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
(defcomp ~blog-settings-layout-mobile ()
|
(defcomp ~layouts/settings-layout-mobile ()
|
||||||
(~blog-settings-nav))
|
(~layouts/settings-nav))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Cache layout (root + settings + cache sub-header)
|
;; Cache layout (root + settings + cache sub-header)
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~blog-cache-layout-full ()
|
(defcomp ~layouts/cache-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~blog-settings-header-auto)
|
(~blog-settings-header-auto)
|
||||||
(~blog-sub-settings-header-auto
|
(~blog-sub-settings-header-auto
|
||||||
"cache-row" "cache-header-child"
|
"cache-row" "cache-header-child"
|
||||||
"settings.defpage_cache_page" "refresh" "Cache")))
|
"settings.defpage_cache_page" "refresh" "Cache")))
|
||||||
|
|
||||||
(defcomp ~blog-cache-layout-oob ()
|
(defcomp ~layouts/cache-layout-oob ()
|
||||||
(<> (~blog-sub-settings-header-auto
|
(<> (~blog-sub-settings-header-auto
|
||||||
"cache-row" "cache-header-child"
|
"cache-row" "cache-header-child"
|
||||||
"settings.defpage_cache_page" "refresh" "Cache" true)
|
"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)
|
(~blog-settings-header-auto true)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
@@ -83,18 +83,18 @@
|
|||||||
;; Snippets layout (root + settings + snippets sub-header)
|
;; Snippets layout (root + settings + snippets sub-header)
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~blog-snippets-layout-full ()
|
(defcomp ~layouts/snippets-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~blog-settings-header-auto)
|
(~blog-settings-header-auto)
|
||||||
(~blog-sub-settings-header-auto
|
(~blog-sub-settings-header-auto
|
||||||
"snippets-row" "snippets-header-child"
|
"snippets-row" "snippets-header-child"
|
||||||
"snippets.defpage_snippets_page" "puzzle-piece" "Snippets")))
|
"snippets.defpage_snippets_page" "puzzle-piece" "Snippets")))
|
||||||
|
|
||||||
(defcomp ~blog-snippets-layout-oob ()
|
(defcomp ~layouts/snippets-layout-oob ()
|
||||||
(<> (~blog-sub-settings-header-auto
|
(<> (~blog-sub-settings-header-auto
|
||||||
"snippets-row" "snippets-header-child"
|
"snippets-row" "snippets-header-child"
|
||||||
"snippets.defpage_snippets_page" "puzzle-piece" "Snippets" true)
|
"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)
|
(~blog-settings-header-auto true)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
@@ -102,18 +102,18 @@
|
|||||||
;; Menu Items layout (root + settings + menu-items sub-header)
|
;; Menu Items layout (root + settings + menu-items sub-header)
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~blog-menu-items-layout-full ()
|
(defcomp ~layouts/menu-items-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~blog-settings-header-auto)
|
(~blog-settings-header-auto)
|
||||||
(~blog-sub-settings-header-auto
|
(~blog-sub-settings-header-auto
|
||||||
"menu_items-row" "menu_items-header-child"
|
"menu_items-row" "menu_items-header-child"
|
||||||
"menu_items.defpage_menu_items_page" "bars" "Menu Items")))
|
"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
|
(<> (~blog-sub-settings-header-auto
|
||||||
"menu_items-row" "menu_items-header-child"
|
"menu_items-row" "menu_items-header-child"
|
||||||
"menu_items.defpage_menu_items_page" "bars" "Menu Items" true)
|
"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)
|
(~blog-settings-header-auto true)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
@@ -121,18 +121,18 @@
|
|||||||
;; Tag Groups layout (root + settings + tag-groups sub-header)
|
;; Tag Groups layout (root + settings + tag-groups sub-header)
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~blog-tag-groups-layout-full ()
|
(defcomp ~layouts/tag-groups-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~blog-settings-header-auto)
|
(~blog-settings-header-auto)
|
||||||
(~blog-sub-settings-header-auto
|
(~blog-sub-settings-header-auto
|
||||||
"tag-groups-row" "tag-groups-header-child"
|
"tag-groups-row" "tag-groups-header-child"
|
||||||
"blog.tag_groups_admin.defpage_tag_groups_page" "tags" "Tag Groups")))
|
"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
|
(<> (~blog-sub-settings-header-auto
|
||||||
"tag-groups-row" "tag-groups-header-child"
|
"tag-groups-row" "tag-groups-header-child"
|
||||||
"blog.tag_groups_admin.defpage_tag_groups_page" "tags" "Tag Groups" true)
|
"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)
|
(~blog-settings-header-auto true)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
@@ -140,31 +140,31 @@
|
|||||||
;; Tag Group Edit layout (root + settings + tag-groups sub-header with id)
|
;; 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)
|
(<> (~root-header-auto)
|
||||||
(~blog-settings-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"
|
:link-href (url-for "blog.tag_groups_admin.defpage_tag_group_edit"
|
||||||
:id (request-view-args "id"))
|
: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")
|
:icon "fa fa-tags" :label "Tag Groups")
|
||||||
:child-id "tag-groups-header-child")))
|
:child-id "tag-groups-header-child")))
|
||||||
|
|
||||||
(defcomp ~blog-tag-group-edit-layout-oob ()
|
(defcomp ~layouts/tag-group-edit-layout-oob ()
|
||||||
(<> (~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"
|
:link-href (url-for "blog.tag_groups_admin.defpage_tag_group_edit"
|
||||||
:id (request-view-args "id"))
|
: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")
|
:icon "fa fa-tags" :label "Tag Groups")
|
||||||
:child-id "tag-groups-header-child"
|
:child-id "tag-groups-header-child"
|
||||||
:oob true)
|
: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)
|
(~blog-settings-header-auto true)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
;; --- Settings nav links — uses IO primitives ---
|
;; --- Settings nav links — uses IO primitives ---
|
||||||
|
|
||||||
(defcomp ~blog-settings-nav ()
|
(defcomp ~layouts/settings-nav ()
|
||||||
(let* ((sc (select-colours))
|
(let* ((sc (select-colours))
|
||||||
(links (list
|
(links (list
|
||||||
(dict :endpoint "menu_items.defpage_menu_items_page" :icon "fa fa-bars" :label "Menu Items")
|
(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 "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"))))
|
(dict :endpoint "settings.defpage_cache_page" :icon "fa fa-refresh" :label "Cache"))))
|
||||||
(<> (map (lambda (lnk)
|
(<> (map (lambda (lnk)
|
||||||
(~nav-link
|
(~shared:layout/nav-link
|
||||||
:href (url-for (get lnk "endpoint"))
|
:href (url-for (get lnk "endpoint"))
|
||||||
:icon (get lnk "icon")
|
:icon (get lnk "icon")
|
||||||
:label (get lnk "label")
|
:label (get lnk "label")
|
||||||
@@ -181,5 +181,5 @@
|
|||||||
|
|
||||||
;; --- Editor panel wrapper ---
|
;; --- Editor panel wrapper ---
|
||||||
|
|
||||||
(defcomp ~blog-editor-panel (&key parts)
|
(defcomp ~layouts/editor-panel (&key parts)
|
||||||
(<> parts))
|
(<> parts))
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
;; Menu item form and page search components
|
;; 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"
|
(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-id id :data-page-title title :data-page-slug slug
|
||||||
:data-page-image (or feature-image "")
|
:data-page-image (or feature-image "")
|
||||||
@@ -11,50 +11,50 @@
|
|||||||
(div :class "font-medium truncate" title)
|
(div :class "font-medium truncate" title)
|
||||||
(div :class "text-xs text-stone-500 truncate" slug))))
|
(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"
|
(div :class "border border-stone-200 rounded-md max-h-64 overflow-y-auto"
|
||||||
items sentinel))
|
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"
|
(div :sx-get url :sx-trigger "intersect once" :sx-swap "outerHTML"
|
||||||
:sx-vals (str "{\"q\": \"" query "\", \"page\": " next-page "}")
|
:sx-vals (str "{\"q\": \"" query "\", \"page\": " next-page "}")
|
||||||
:class "p-3 text-center text-sm text-stone-400"
|
:class "p-3 text-center text-sm text-stone-400"
|
||||||
(i :class "fa fa-spinner fa-spin") " Loading more..."))
|
(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"
|
(div :class "p-3 text-center text-stone-400 border border-stone-200 rounded-md"
|
||||||
(str "No pages found matching \"" query "\"")))
|
(str "No pages found matching \"" query "\"")))
|
||||||
|
|
||||||
;; Data-driven page search results (replaces Python render_page_search_results loop)
|
;; 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)
|
(if (and (not pages) query)
|
||||||
(~page-search-empty :query query)
|
(~menu_items/page-search-empty :query query)
|
||||||
(when pages
|
(when pages
|
||||||
(~page-search-results
|
(~menu_items/page-search-results
|
||||||
:items (<> (map (lambda (p)
|
:items (<> (map (lambda (p)
|
||||||
(~page-search-item
|
(~menu_items/page-search-item
|
||||||
:id (get p "id") :title (get p "title")
|
:id (get p "id") :title (get p "title")
|
||||||
:slug (get p "slug") :feature-image (get p "feature_image")))
|
:slug (get p "slug") :feature-image (get p "feature_image")))
|
||||||
pages))
|
pages))
|
||||||
:sentinel (when has-more
|
: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)
|
;; 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)
|
(if (not items)
|
||||||
(~blog-nav-empty :wrapper-id "menu-items-nav-wrapper")
|
(~shared:nav/blog-nav-empty :wrapper-id "menu-items-nav-wrapper")
|
||||||
(~scroll-nav-wrapper :wrapper-id "menu-items-nav-wrapper" :container-id container-id
|
(~shared:misc/scroll-nav-wrapper :wrapper-id "menu-items-nav-wrapper" :container-id container-id
|
||||||
:arrow-cls arrow-cls
|
:arrow-cls arrow-cls
|
||||||
:left-hs (str "on click set #" container-id ".scrollLeft to #" container-id ".scrollLeft - 200")
|
:left-hs (str "on click set #" container-id ".scrollLeft to #" container-id ".scrollLeft - 200")
|
||||||
:scroll-hs scroll-hs
|
:scroll-hs scroll-hs
|
||||||
:right-hs (str "on click set #" container-id ".scrollLeft to #" container-id ".scrollLeft + 200")
|
:right-hs (str "on click set #" container-id ".scrollLeft to #" container-id ".scrollLeft + 200")
|
||||||
:items (<> (map (lambda (item)
|
: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")))
|
:size-cls "w-8 h-8 rounded-full object-cover flex-shrink-0")))
|
||||||
(if (= (get item "slug") "cart")
|
(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"))
|
: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")))))
|
:selected (get item "selected") :nav-cls nav-cls :img img :label (get item "label")))))
|
||||||
items))
|
items))
|
||||||
:oob true)))
|
:oob true)))
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
;; Blog settings panel components (features, markets, associated entries)
|
;; 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"
|
(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"
|
:sx-headers {:Content-Type "application/json"} :sx-encoding "json" :class "space-y-3"
|
||||||
(label :class "flex items-center gap-3 cursor-pointer"
|
(label :class "flex items-center gap-3 cursor-pointer"
|
||||||
@@ -18,33 +18,33 @@
|
|||||||
(i :class "fa fa-shopping-bag text-green-600 mr-1")
|
(i :class "fa fa-shopping-bag text-green-600 mr-1")
|
||||||
" Market \u2014 enable product catalog on this page"))))
|
" 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"
|
(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
|
:placeholder placeholder :sumup-configured sumup-configured
|
||||||
:checkout-prefix checkout-prefix :panel-id "features-panel")))
|
: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"
|
(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")
|
(h3 :class "text-lg font-semibold text-stone-800" "Page Features")
|
||||||
form sumup))
|
form sumup))
|
||||||
|
|
||||||
;; Markets panel
|
;; 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"
|
(li :class "flex items-center justify-between p-3 bg-stone-50 rounded"
|
||||||
(div (span :class "font-medium" name)
|
(div (span :class "font-medium" name)
|
||||||
(span :class "text-stone-400 text-sm ml-2" (str "/" slug "/")))
|
(span :class "text-stone-400 text-sm ml-2" (str "/" slug "/")))
|
||||||
(button :sx-delete delete-url :sx-target "#markets-panel" :sx-swap "outerHTML"
|
(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")))
|
: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))
|
(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."))
|
(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"
|
(div :id "markets-panel"
|
||||||
(h3 :class "text-lg font-semibold mb-3" "Markets")
|
(h3 :class "text-lg font-semibold mb-3" "Markets")
|
||||||
list
|
list
|
||||||
@@ -59,17 +59,17 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
;; Features panel composition — replaces render_features_panel
|
;; 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
|
show-sumup sumup-url merchant-code placeholder
|
||||||
sumup-configured checkout-prefix)
|
sumup-configured checkout-prefix)
|
||||||
(~blog-features-panel
|
(~settings/features-panel
|
||||||
:form (~blog-features-form
|
:form (~settings/features-form
|
||||||
:features-url features-url
|
:features-url features-url
|
||||||
:calendar-checked calendar-checked
|
:calendar-checked calendar-checked
|
||||||
:market-checked market-checked
|
:market-checked market-checked
|
||||||
:hs-trigger "on change trigger submit on closest <form/>")
|
:hs-trigger "on change trigger submit on closest <form/>")
|
||||||
:sumup (when show-sumup
|
:sumup (when show-sumup
|
||||||
(~blog-sumup-form
|
(~settings/sumup-form
|
||||||
:sumup-url sumup-url
|
:sumup-url sumup-url
|
||||||
:merchant-code merchant-code
|
:merchant-code merchant-code
|
||||||
:placeholder placeholder
|
:placeholder placeholder
|
||||||
@@ -77,13 +77,13 @@
|
|||||||
:checkout-prefix checkout-prefix))))
|
:checkout-prefix checkout-prefix))))
|
||||||
|
|
||||||
;; Markets panel composition — replaces render_markets_panel
|
;; Markets panel composition — replaces render_markets_panel
|
||||||
(defcomp ~blog-markets-panel-content (&key markets create-url)
|
(defcomp ~settings/markets-panel-content (&key markets create-url)
|
||||||
(~blog-markets-panel
|
(~settings/markets-panel
|
||||||
:list (if (empty? (or markets (list)))
|
:list (if (empty? (or markets (list)))
|
||||||
(~blog-markets-empty)
|
(~settings/markets-empty)
|
||||||
(~blog-markets-list
|
(~settings/markets-list
|
||||||
:items (map (lambda (m)
|
:items (map (lambda (m)
|
||||||
(~blog-market-item
|
(~settings/market-item
|
||||||
:name (get m "name")
|
:name (get m "name")
|
||||||
:slug (get m "slug")
|
:slug (get m "slug")
|
||||||
:delete-url (get m "delete_url")
|
:delete-url (get m "delete_url")
|
||||||
@@ -93,11 +93,11 @@
|
|||||||
|
|
||||||
;; Associated entries
|
;; 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")
|
(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")))
|
(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"
|
(button :type "button"
|
||||||
:class "w-full text-left p-3 rounded border bg-green-50 border-green-300 transition hover:bg-green-100"
|
: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?"
|
:data-confirm "" :data-confirm-title "Remove entry?"
|
||||||
@@ -115,14 +115,14 @@
|
|||||||
(div :class "text-xs text-stone-600 mt-1" date-str))
|
(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"))))
|
(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))
|
(div :class "space-y-1" items))
|
||||||
|
|
||||||
(defcomp ~blog-associated-entries-empty ()
|
(defcomp ~settings/associated-entries-empty ()
|
||||||
(div :class "text-sm text-stone-400"
|
(div :class "text-sm text-stone-400"
|
||||||
"No entries associated yet. Browse calendars below to add entries."))
|
"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"
|
(div :id "associated-entries-list" :class "border rounded-lg p-4 bg-white"
|
||||||
(h3 :class "text-lg font-semibold mb-4" "Associated Entries")
|
(h3 :class "text-lg font-semibold mb-4" "Associated Entries")
|
||||||
content))
|
content))
|
||||||
@@ -131,17 +131,17 @@
|
|||||||
;; Associated entries composition — replaces _render_associated_entries
|
;; Associated entries composition — replaces _render_associated_entries
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~blog-associated-entries-from-data (&key entries csrf)
|
(defcomp ~settings/associated-entries-from-data (&key entries csrf)
|
||||||
(~blog-associated-entries-panel
|
(~settings/associated-entries-panel
|
||||||
:content (if (empty? (or entries (list)))
|
:content (if (empty? (or entries (list)))
|
||||||
(~blog-associated-entries-empty)
|
(~settings/associated-entries-empty)
|
||||||
(~blog-associated-entries-content
|
(~settings/associated-entries-content
|
||||||
:items (map (lambda (e)
|
:items (map (lambda (e)
|
||||||
(~blog-associated-entry
|
(~settings/associated-entry
|
||||||
:confirm-text (get e "confirm_text")
|
:confirm-text (get e "confirm_text")
|
||||||
:toggle-url (get e "toggle_url")
|
:toggle-url (get e "toggle_url")
|
||||||
:hx-headers {:X-CSRFToken csrf}
|
: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")
|
:name (get e "name")
|
||||||
:date-str (get e "date_str")))
|
:date-str (get e "date_str")))
|
||||||
(or entries (list)))))))
|
(or entries (list)))))))
|
||||||
@@ -150,7 +150,7 @@
|
|||||||
;; Entries browser composition — replaces _h_post_entries_content
|
;; 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"
|
(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"
|
(summary :class "p-4 cursor-pointer hover:bg-stone-50 flex items-center gap-3"
|
||||||
(if image
|
(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 "p-4 border-t" :sx-get view-url :sx-trigger "intersect once" :sx-swap "innerHTML"
|
||||||
(div :class "text-sm text-stone-400" "Loading calendar..."))))
|
(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"
|
(div :id "post-entries-content" :class "space-y-6 p-4"
|
||||||
entries-panel
|
entries-panel
|
||||||
(div :class "space-y-3"
|
(div :class "space-y-3"
|
||||||
@@ -171,7 +171,7 @@
|
|||||||
(if (empty? (or calendars (list)))
|
(if (empty? (or calendars (list)))
|
||||||
(div :class "text-sm text-stone-400" "No calendars found.")
|
(div :class "text-sm text-stone-400" "No calendars found.")
|
||||||
(map (lambda (cal)
|
(map (lambda (cal)
|
||||||
(~blog-calendar-browser-item
|
(~settings/calendar-browser-item
|
||||||
:name (get cal "name")
|
:name (get cal "name")
|
||||||
:title (get cal "title")
|
:title (get cal "title")
|
||||||
:image (get cal "image")
|
:image (get cal "image")
|
||||||
@@ -182,17 +182,17 @@
|
|||||||
;; Post settings form composition — replaces _h_post_settings_content
|
;; 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
|
(label :for field-for
|
||||||
:class "block text-[13px] font-medium text-stone-500 mb-[4px]" text))
|
: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
|
(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"
|
(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)
|
title)
|
||||||
(div :class "px-[16px] py-[12px] space-y-[12px]" content)))
|
(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
|
slug published-at featured visibility email-only
|
||||||
tags feature-image-alt
|
tags feature-image-alt
|
||||||
meta-title meta-description canonical-url
|
meta-title meta-description canonical-url
|
||||||
@@ -209,19 +209,19 @@
|
|||||||
(input :type "hidden" :name "updated_at" :value (or updated-at ""))
|
(input :type "hidden" :name "updated_at" :value (or updated-at ""))
|
||||||
(div :class "space-y-[12px] mt-[16px]"
|
(div :class "space-y-[12px] mt-[16px]"
|
||||||
;; General
|
;; 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 "")
|
(input :type "text" :name "slug" :id "settings-slug" :value (or slug "")
|
||||||
:placeholder slug-placeholder :class input-cls))
|
: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"
|
(input :type "datetime-local" :name "published_at" :id "settings-published_at"
|
||||||
:value (or published-at "") :class input-cls))
|
:value (or published-at "") :class input-cls))
|
||||||
(div (label :class "inline-flex items-center gap-[8px] cursor-pointer"
|
(div (label :class "inline-flex items-center gap-[8px] cursor-pointer"
|
||||||
(input :type "checkbox" :name "featured" :id "settings-featured" :checked featured
|
(input :type "checkbox" :name "featured" :id "settings-featured" :checked featured
|
||||||
:class "rounded border-stone-300 text-stone-600 focus:ring-stone-300")
|
:class "rounded border-stone-300 text-stone-600 focus:ring-stone-300")
|
||||||
(span :class "text-[14px] text-stone-600" featured-label)))
|
(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
|
(select :name "visibility" :id "settings-visibility" :class input-cls
|
||||||
(option :value "public" :selected (= visibility "public") "Public")
|
(option :value "public" :selected (= visibility "public") "Public")
|
||||||
(option :value "members" :selected (= visibility "members") "Members")
|
(option :value "members" :selected (= visibility "members") "Members")
|
||||||
@@ -231,57 +231,57 @@
|
|||||||
:class "rounded border-stone-300 text-stone-600 focus:ring-stone-300")
|
:class "rounded border-stone-300 text-stone-600 focus:ring-stone-300")
|
||||||
(span :class "text-[14px] text-stone-600" "Email only")))))
|
(span :class "text-[14px] text-stone-600" "Email only")))))
|
||||||
;; Tags
|
;; Tags
|
||||||
(~blog-settings-section :title "Tags" :content
|
(~settings/section :title "Tags" :content
|
||||||
(div (~blog-settings-field-label :text "Tags (comma-separated)" :field-for "settings-tags")
|
(div (~settings/field-label :text "Tags (comma-separated)" :field-for "settings-tags")
|
||||||
(input :type "text" :name "tags" :id "settings-tags" :value (or tags "")
|
(input :type "text" :name "tags" :id "settings-tags" :value (or tags "")
|
||||||
:placeholder "news, updates, featured" :class input-cls)
|
:placeholder "news, updates, featured" :class input-cls)
|
||||||
(p :class "text-[12px] text-stone-400 mt-[4px]" "Unknown tags will be created automatically.")))
|
(p :class "text-[12px] text-stone-400 mt-[4px]" "Unknown tags will be created automatically.")))
|
||||||
;; Feature Image
|
;; Feature Image
|
||||||
(~blog-settings-section :title "Feature Image" :content
|
(~settings/section :title "Feature Image" :content
|
||||||
(div (~blog-settings-field-label :text "Alt text" :field-for "settings-feature_image_alt")
|
(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"
|
(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)))
|
:value (or feature-image-alt "") :placeholder "Describe the feature image" :class input-cls)))
|
||||||
;; SEO / Meta
|
;; 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 "")
|
(input :type "text" :name "meta_title" :id "settings-meta_title" :value (or meta-title "")
|
||||||
:placeholder "SEO title" :maxlength "300" :class input-cls)
|
:placeholder "SEO title" :maxlength "300" :class input-cls)
|
||||||
(p :class "text-[12px] text-stone-400 mt-[2px]" "Recommended: 70 characters. Max: 300."))
|
(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"
|
(textarea :name "meta_description" :id "settings-meta_description" :rows "2"
|
||||||
:placeholder "SEO description" :maxlength "500" :class textarea-cls
|
:placeholder "SEO description" :maxlength "500" :class textarea-cls
|
||||||
(or meta-description ""))
|
(or meta-description ""))
|
||||||
(p :class "text-[12px] text-stone-400 mt-[2px]" "Recommended: 156 characters."))
|
(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"
|
(input :type "url" :name "canonical_url" :id "settings-canonical_url"
|
||||||
:value (or canonical-url "") :placeholder "https://example.com/original-post" :class input-cls))))
|
:value (or canonical-url "") :placeholder "https://example.com/original-post" :class input-cls))))
|
||||||
;; Facebook / OpenGraph
|
;; 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))
|
(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
|
(textarea :name "og_description" :id "settings-og_description" :rows "2" :class textarea-cls
|
||||||
(or og-description "")))
|
(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 "")
|
(input :type "url" :name "og_image" :id "settings-og_image" :value (or og-image "")
|
||||||
:placeholder "https://..." :class input-cls))))
|
:placeholder "https://..." :class input-cls))))
|
||||||
;; X / Twitter
|
;; 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"
|
(input :type "text" :name "twitter_title" :id "settings-twitter_title"
|
||||||
:value (or twitter-title "") :class input-cls))
|
: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
|
(textarea :name "twitter_description" :id "settings-twitter_description" :rows "2" :class textarea-cls
|
||||||
(or twitter-description "")))
|
(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"
|
(input :type "url" :name "twitter_image" :id "settings-twitter_image"
|
||||||
:value (or twitter-image "") :placeholder "https://..." :class input-cls))))
|
:value (or twitter-image "") :placeholder "https://..." :class input-cls))))
|
||||||
;; Advanced
|
;; Advanced
|
||||||
(~blog-settings-section :title "Advanced" :content
|
(~settings/section :title "Advanced" :content
|
||||||
(div (~blog-settings-field-label :text "Custom template" :field-for "settings-custom_template")
|
(div (~settings/field-label :text "Custom template" :field-for "settings-custom_template")
|
||||||
(input :type "text" :name "custom_template" :id "settings-custom_template"
|
(input :type "text" :name "custom_template" :id "settings-custom_template"
|
||||||
:value (or custom-template "") :placeholder tmpl-placeholder :class input-cls))))
|
: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"
|
(div :class "flex items-center gap-[16px] mt-[24px] pt-[16px] border-t border-stone-200"
|
||||||
|
|||||||
@@ -9,7 +9,7 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :blog
|
:layout :blog
|
||||||
:data (editor-data)
|
:data (editor-data)
|
||||||
:content (~blog-editor-content
|
:content (~editor/content
|
||||||
:csrf csrf :title-placeholder title-placeholder
|
:csrf csrf :title-placeholder title-placeholder
|
||||||
:create-label create-label :css-href css-href
|
:create-label create-label :css-href css-href
|
||||||
:js-src js-src :sx-editor-js-src sx-editor-js-src
|
:js-src js-src :sx-editor-js-src sx-editor-js-src
|
||||||
@@ -20,7 +20,7 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :blog
|
:layout :blog
|
||||||
:data (editor-page-data)
|
:data (editor-page-data)
|
||||||
:content (~blog-editor-content
|
:content (~editor/content
|
||||||
:csrf csrf :title-placeholder title-placeholder
|
:csrf csrf :title-placeholder title-placeholder
|
||||||
:create-label create-label :css-href css-href
|
:create-label create-label :css-href css-href
|
||||||
:js-src js-src :sx-editor-js-src sx-editor-js-src
|
:js-src js-src :sx-editor-js-src sx-editor-js-src
|
||||||
@@ -33,21 +33,21 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout (:post-admin :selected "admin")
|
:layout (:post-admin :selected "admin")
|
||||||
:data (post-admin-data slug)
|
:data (post-admin-data slug)
|
||||||
:content (~blog-admin-placeholder))
|
:content (~admin/placeholder))
|
||||||
|
|
||||||
(defpage post-data
|
(defpage post-data
|
||||||
:path "/<slug>/admin/data/"
|
:path "/<slug>/admin/data/"
|
||||||
:auth :admin
|
:auth :admin
|
||||||
:layout (:post-admin :selected "data")
|
:layout (:post-admin :selected "data")
|
||||||
:data (post-data-data slug)
|
: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
|
(defpage post-preview
|
||||||
:path "/<slug>/admin/preview/"
|
:path "/<slug>/admin/preview/"
|
||||||
:auth :admin
|
:auth :admin
|
||||||
:layout (:post-admin :selected "preview")
|
:layout (:post-admin :selected "preview")
|
||||||
:data (post-preview-data slug)
|
:data (post-preview-data slug)
|
||||||
:content (~blog-preview-content
|
:content (~admin/preview-content
|
||||||
:sx-pretty sx-pretty :json-pretty json-pretty
|
:sx-pretty sx-pretty :json-pretty json-pretty
|
||||||
:sx-rendered sx-rendered :lex-rendered lex-rendered))
|
:sx-rendered sx-rendered :lex-rendered lex-rendered))
|
||||||
|
|
||||||
@@ -56,8 +56,8 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout (:post-admin :selected "entries")
|
:layout (:post-admin :selected "entries")
|
||||||
:data (post-entries-data slug)
|
:data (post-entries-data slug)
|
||||||
:content (~blog-entries-browser-content
|
:content (~settings/entries-browser-content
|
||||||
:entries-panel (~blog-associated-entries-from-data :entries entries :csrf csrf)
|
:entries-panel (~settings/associated-entries-from-data :entries entries :csrf csrf)
|
||||||
:calendars calendars))
|
:calendars calendars))
|
||||||
|
|
||||||
(defpage post-settings
|
(defpage post-settings
|
||||||
@@ -65,7 +65,7 @@
|
|||||||
:auth :post_author
|
:auth :post_author
|
||||||
:layout (:post-admin :selected "settings")
|
:layout (:post-admin :selected "settings")
|
||||||
:data (post-settings-data slug)
|
:data (post-settings-data slug)
|
||||||
:content (~blog-settings-form-content
|
:content (~settings/form-content
|
||||||
:csrf csrf :updated-at updated-at :is-page is-page
|
:csrf csrf :updated-at updated-at :is-page is-page
|
||||||
:save-success save-success :slug settings-slug
|
:save-success save-success :slug settings-slug
|
||||||
:published-at published-at :featured featured
|
:published-at published-at :featured featured
|
||||||
@@ -82,7 +82,7 @@
|
|||||||
:auth :post_author
|
:auth :post_author
|
||||||
:layout (:post-admin :selected "edit")
|
:layout (:post-admin :selected "edit")
|
||||||
:data (post-edit-data slug)
|
:data (post-edit-data slug)
|
||||||
:content (~blog-edit-content
|
:content (~editor/edit-content
|
||||||
:csrf csrf :updated-at updated-at
|
:csrf csrf :updated-at updated-at
|
||||||
:title-val title-val :excerpt-val excerpt-val
|
:title-val title-val :excerpt-val excerpt-val
|
||||||
:feature-image feature-image :feature-image-caption feature-image-caption
|
:feature-image feature-image :feature-image-caption feature-image-caption
|
||||||
@@ -111,7 +111,7 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :blog-cache
|
:layout :blog-cache
|
||||||
:data (service "blog-page" "cache-data")
|
: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 ---
|
; --- Snippets ---
|
||||||
|
|
||||||
@@ -120,7 +120,7 @@
|
|||||||
:auth :login
|
:auth :login
|
||||||
:layout :blog-snippets
|
:layout :blog-snippets
|
||||||
:data (service "blog-page" "snippets-data")
|
:data (service "blog-page" "snippets-data")
|
||||||
:content (~blog-snippets-content
|
:content (~admin/snippets-content
|
||||||
:snippets snippets :is-admin is-admin :csrf csrf))
|
:snippets snippets :is-admin is-admin :csrf csrf))
|
||||||
|
|
||||||
; --- Menu Items ---
|
; --- Menu Items ---
|
||||||
@@ -130,7 +130,7 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :blog-menu-items
|
:layout :blog-menu-items
|
||||||
:data (service "blog-page" "menu-items-data")
|
: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))
|
:menu-items menu-items :new-url new-url :csrf csrf))
|
||||||
|
|
||||||
; --- Tag Groups ---
|
; --- Tag Groups ---
|
||||||
@@ -140,7 +140,7 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :blog-tag-groups
|
:layout :blog-tag-groups
|
||||||
:data (service "blog-page" "tag-groups-data")
|
:data (service "blog-page" "tag-groups-data")
|
||||||
:content (~blog-tag-groups-content
|
:content (~admin/tag-groups-content
|
||||||
:groups groups :unassigned-tags unassigned-tags
|
:groups groups :unassigned-tags unassigned-tags
|
||||||
:create-url create-url :csrf csrf))
|
:create-url create-url :csrf csrf))
|
||||||
|
|
||||||
@@ -149,6 +149,6 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :blog-tag-group-edit
|
:layout :blog-tag-group-edit
|
||||||
:data (service "blog-page" "tag-group-edit-data" :id id)
|
: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
|
:group group :all-tags all-tags
|
||||||
:save-url save-url :delete-url delete-url :csrf csrf))
|
:save-url save-url :delete-url delete-url :csrf csrf))
|
||||||
|
|||||||
@@ -167,7 +167,7 @@ class TestCards:
|
|||||||
result = lexical_to_sx(_doc({
|
result = lexical_to_sx(_doc({
|
||||||
"type": "image", "src": "photo.jpg", "alt": "test"
|
"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):
|
def test_image_wide_with_caption(self):
|
||||||
result = lexical_to_sx(_doc({
|
result = lexical_to_sx(_doc({
|
||||||
@@ -189,7 +189,7 @@ class TestCards:
|
|||||||
"type": "bookmark", "url": "https://example.com",
|
"type": "bookmark", "url": "https://example.com",
|
||||||
"metadata": {"title": "Example", "description": "A site"}
|
"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 ':url "https://example.com"' in result
|
||||||
assert ':title "Example"' in result
|
assert ':title "Example"' in result
|
||||||
|
|
||||||
@@ -199,7 +199,7 @@ class TestCards:
|
|||||||
"calloutEmoji": "💡",
|
"calloutEmoji": "💡",
|
||||||
"children": [_text("Note")]
|
"children": [_text("Note")]
|
||||||
}))
|
}))
|
||||||
assert "(~kg-callout " in result
|
assert "(~kg_cards/kg-callout " in result
|
||||||
assert ':color "blue"' in result
|
assert ':color "blue"' in result
|
||||||
|
|
||||||
def test_button(self):
|
def test_button(self):
|
||||||
@@ -207,7 +207,7 @@ class TestCards:
|
|||||||
"type": "button", "buttonText": "Click",
|
"type": "button", "buttonText": "Click",
|
||||||
"buttonUrl": "https://example.com"
|
"buttonUrl": "https://example.com"
|
||||||
}))
|
}))
|
||||||
assert "(~kg-button " in result
|
assert "(~kg_cards/kg-button " in result
|
||||||
assert ':text "Click"' in result
|
assert ':text "Click"' in result
|
||||||
|
|
||||||
def test_toggle(self):
|
def test_toggle(self):
|
||||||
@@ -215,28 +215,28 @@ class TestCards:
|
|||||||
"type": "toggle", "heading": "FAQ",
|
"type": "toggle", "heading": "FAQ",
|
||||||
"children": [_text("Answer")]
|
"children": [_text("Answer")]
|
||||||
}))
|
}))
|
||||||
assert "(~kg-toggle " in result
|
assert "(~kg_cards/kg-toggle " in result
|
||||||
assert ':heading "FAQ"' in result
|
assert ':heading "FAQ"' in result
|
||||||
|
|
||||||
def test_html(self):
|
def test_html(self):
|
||||||
result = lexical_to_sx(_doc({
|
result = lexical_to_sx(_doc({
|
||||||
"type": "html", "html": "<div>custom</div>"
|
"type": "html", "html": "<div>custom</div>"
|
||||||
}))
|
}))
|
||||||
assert result == '(~kg-html (div "custom"))'
|
assert result == '(~kg_cards/kg-html (div "custom"))'
|
||||||
|
|
||||||
def test_embed(self):
|
def test_embed(self):
|
||||||
result = lexical_to_sx(_doc({
|
result = lexical_to_sx(_doc({
|
||||||
"type": "embed", "html": "<iframe></iframe>",
|
"type": "embed", "html": "<iframe></iframe>",
|
||||||
"caption": "Video"
|
"caption": "Video"
|
||||||
}))
|
}))
|
||||||
assert "(~kg-embed " in result
|
assert "(~kg_cards/kg-embed " in result
|
||||||
assert ':caption "Video"' in result
|
assert ':caption "Video"' in result
|
||||||
|
|
||||||
def test_markdown(self):
|
def test_markdown(self):
|
||||||
result = lexical_to_sx(_doc({
|
result = lexical_to_sx(_doc({
|
||||||
"type": "markdown", "markdown": "**bold** text"
|
"type": "markdown", "markdown": "**bold** text"
|
||||||
}))
|
}))
|
||||||
assert result.startswith("(~kg-md ")
|
assert result.startswith("(~kg_cards/kg-md ")
|
||||||
assert "(p " in result
|
assert "(p " in result
|
||||||
assert "(strong " in result
|
assert "(strong " in result
|
||||||
|
|
||||||
@@ -244,14 +244,14 @@ class TestCards:
|
|||||||
result = lexical_to_sx(_doc({
|
result = lexical_to_sx(_doc({
|
||||||
"type": "video", "src": "v.mp4", "cardWidth": "wide"
|
"type": "video", "src": "v.mp4", "cardWidth": "wide"
|
||||||
}))
|
}))
|
||||||
assert "(~kg-video " in result
|
assert "(~kg_cards/kg-video " in result
|
||||||
assert ':width "wide"' in result
|
assert ':width "wide"' in result
|
||||||
|
|
||||||
def test_audio(self):
|
def test_audio(self):
|
||||||
result = lexical_to_sx(_doc({
|
result = lexical_to_sx(_doc({
|
||||||
"type": "audio", "src": "s.mp3", "title": "Song", "duration": 195
|
"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
|
assert ':duration "3:15"' in result
|
||||||
|
|
||||||
def test_file(self):
|
def test_file(self):
|
||||||
@@ -259,13 +259,13 @@ class TestCards:
|
|||||||
"type": "file", "src": "f.pdf", "fileName": "doc.pdf",
|
"type": "file", "src": "f.pdf", "fileName": "doc.pdf",
|
||||||
"fileSize": 2100000
|
"fileSize": 2100000
|
||||||
}))
|
}))
|
||||||
assert "(~kg-file " in result
|
assert "(~kg_cards/kg-file " in result
|
||||||
assert ':filename "doc.pdf"' in result
|
assert ':filename "doc.pdf"' in result
|
||||||
assert "MB" in result
|
assert "MB" in result
|
||||||
|
|
||||||
def test_paywall(self):
|
def test_paywall(self):
|
||||||
result = lexical_to_sx(_doc({"type": "paywall"}))
|
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
|
;; 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"
|
(li :class "flex items-start justify-between text-sm"
|
||||||
(div (div :class "font-medium" name)
|
(div (div :class "font-medium" name)
|
||||||
(div :class "text-xs text-stone-500" date-str))
|
(div :class "text-xs text-stone-500" date-str))
|
||||||
(div :class "ml-4 font-medium" cost)))
|
(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"
|
(div :class "mt-6 border-t border-stone-200 pt-4"
|
||||||
(h2 :class "text-base font-semibold mb-2" "Calendar bookings")
|
(h2 :class "text-base font-semibold mb-2" "Calendar bookings")
|
||||||
(ul :class "space-y-2" items)))
|
(ul :class "space-y-2" items)))
|
||||||
|
|||||||
@@ -4,6 +4,6 @@
|
|||||||
;; Renders the "orders" link for the account dashboard nav.
|
;; Renders the "orders" link for the account dashboard nav.
|
||||||
|
|
||||||
(defhandler account-nav-item (&key)
|
(defhandler account-nav-item (&key)
|
||||||
(~account-nav-item
|
(~shared:fragments/account-nav-item
|
||||||
:href (app-url "cart" "/orders/")
|
:href (app-url "cart" "/orders/")
|
||||||
:label "orders"))
|
:label "orders"))
|
||||||
|
|||||||
@@ -10,7 +10,7 @@
|
|||||||
(count (+ (or (get summary "count") 0)
|
(count (+ (or (get summary "count") 0)
|
||||||
(or (get summary "calendar_count") 0)
|
(or (get summary "calendar_count") 0)
|
||||||
(or (get summary "ticket_count") 0))))
|
(or (get summary "ticket_count") 0))))
|
||||||
(~cart-mini
|
(~shared:fragments/cart-mini
|
||||||
:cart-count count
|
:cart-count count
|
||||||
:blog-url (app-url "blog" "")
|
:blog-url (app-url "blog" "")
|
||||||
:cart-url (app-url "cart" "")
|
:cart-url (app-url "cart" "")
|
||||||
|
|||||||
@@ -1,14 +1,14 @@
|
|||||||
;; Cart header components
|
;; 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"))
|
(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
|
(<> (when feature-image
|
||||||
(~cart-page-label-img :src feature-image))
|
(~header/page-label-img :src feature-image))
|
||||||
(span title)))
|
(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"
|
(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"))
|
(i :class "fa fa-arrow-left text-xs" :aria-hidden "true") "All carts"))
|
||||||
|
|
||||||
|
|||||||
@@ -1,29 +1,29 @@
|
|||||||
;; Cart item components
|
;; 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"))
|
(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))
|
(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))
|
(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"))
|
(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"
|
(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")
|
(i :class "fa-solid fa-triangle-exclamation text-[0.6rem]" :aria-hidden "true")
|
||||||
" This item is no longer available or price has changed"))
|
" 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))
|
(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))
|
(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"
|
(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 "w-full sm:w-32 shrink-0 flex justify-center sm:block" (when img img))
|
||||||
(div :class "flex-1 min-w-0"
|
(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" "+")))
|
(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))))))
|
(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 :class "max-w-full px-3 py-3 space-y-3"
|
||||||
(div :id "cart"
|
(div :id "cart"
|
||||||
(div (section :class "space-y-3 sm:space-y-4" items cal tickets)
|
(div (section :class "space-y-3 sm:space-y-4" items cal tickets)
|
||||||
summary))))
|
summary))))
|
||||||
|
|
||||||
;; Assembled cart item from serialized data — replaces Python _cart_item_sx
|
;; 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") ""))
|
(let* ((slug (or (get item "slug") ""))
|
||||||
(title (or (get item "title") ""))
|
(title (or (get item "title") ""))
|
||||||
(image (get item "image"))
|
(image (get item "image"))
|
||||||
@@ -71,48 +71,48 @@
|
|||||||
(qty-url (or (get item "qty_url") ""))
|
(qty-url (or (get item "qty_url") ""))
|
||||||
(csrf (csrf-token))
|
(csrf (csrf-token))
|
||||||
(line-total (when unit-price (* unit-price quantity))))
|
(line-total (when unit-price (* unit-price quantity))))
|
||||||
(~cart-item
|
(~items/index
|
||||||
:id (str "cart-item-" slug)
|
:id (str "cart-item-" slug)
|
||||||
:img (if image
|
:img (if image
|
||||||
(~cart-item-img :src image :alt title)
|
(~items/img :src image :alt title)
|
||||||
(~img-or-placeholder :src nil
|
(~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"
|
:size-cls "w-24 h-24 sm:w-32 sm:h-28 rounded-xl border border-dashed border-stone-300"
|
||||||
:placeholder-text "No image"))
|
:placeholder-text "No image"))
|
||||||
:prod-url prod-url
|
:prod-url prod-url
|
||||||
:title title
|
:title title
|
||||||
:brand (when brand (~cart-item-brand :brand brand))
|
:brand (when brand (~items/brand :brand brand))
|
||||||
:deleted (when is-deleted (~cart-item-deleted))
|
:deleted (when is-deleted (~items/deleted))
|
||||||
:price (if unit-price
|
: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))
|
(when (and special-price (!= special-price regular-price))
|
||||||
(~cart-item-price-was :text (str symbol (format-decimal regular-price 2)))))
|
(~items/price-was :text (str symbol (format-decimal regular-price 2)))))
|
||||||
(~cart-item-no-price))
|
(~items/no-price))
|
||||||
:qty-url qty-url :csrf csrf
|
:qty-url qty-url :csrf csrf
|
||||||
:minus (str (- quantity 1))
|
:minus (str (- quantity 1))
|
||||||
:qty (str quantity)
|
:qty (str quantity)
|
||||||
:plus (str (+ quantity 1))
|
:plus (str (+ quantity 1))
|
||||||
:line-total (when line-total
|
: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
|
;; 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))
|
(when (not (empty? entries))
|
||||||
(~cart-cal-section
|
(~calendar/cal-section
|
||||||
:items (map (lambda (e)
|
:items (map (lambda (e)
|
||||||
(let* ((name (or (get e "name") ""))
|
(let* ((name (or (get e "name") ""))
|
||||||
(date-str (or (get e "date_str") "")))
|
(date-str (or (get e "date_str") "")))
|
||||||
(~cart-cal-entry
|
(~calendar/cal-entry
|
||||||
:name name :date-str date-str
|
:name name :date-str date-str
|
||||||
:cost (str "\u00a3" (format-decimal (or (get e "cost") 0) 2)))))
|
:cost (str "\u00a3" (format-decimal (or (get e "cost") 0) 2)))))
|
||||||
entries))))
|
entries))))
|
||||||
|
|
||||||
;; Assembled ticket groups section — replaces Python _ticket_groups_sx
|
;; 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))
|
(when (not (empty? ticket-groups))
|
||||||
(let* ((csrf (csrf-token))
|
(let* ((csrf (csrf-token))
|
||||||
(qty-url (url-for "cart_global.update_ticket_quantity")))
|
(qty-url (url-for "cart_global.update_ticket_quantity")))
|
||||||
(~cart-tickets-section
|
(~tickets/section
|
||||||
:items (map (lambda (tg)
|
:items (map (lambda (tg)
|
||||||
(let* ((name (or (get tg "entry_name") ""))
|
(let* ((name (or (get tg "entry_name") ""))
|
||||||
(tt-name (get tg "ticket_type_name"))
|
(tt-name (get tg "ticket_type_name"))
|
||||||
@@ -122,14 +122,14 @@
|
|||||||
(entry-id (str (or (get tg "entry_id") "")))
|
(entry-id (str (or (get tg "entry_id") "")))
|
||||||
(tt-id (get tg "ticket_type_id"))
|
(tt-id (get tg "ticket_type_id"))
|
||||||
(date-str (or (get tg "date_str") "")))
|
(date-str (or (get tg "date_str") "")))
|
||||||
(~cart-ticket-article
|
(~tickets/article
|
||||||
:name name
|
: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
|
:date-str date-str
|
||||||
:price (str "\u00a3" (format-decimal price 2))
|
:price (str "\u00a3" (format-decimal price 2))
|
||||||
:qty-url qty-url :csrf csrf
|
:qty-url qty-url :csrf csrf
|
||||||
:entry-id entry-id
|
: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))
|
:minus (str (max (- quantity 1) 0))
|
||||||
:qty (str quantity)
|
:qty (str quantity)
|
||||||
:plus (str (+ quantity 1))
|
:plus (str (+ quantity 1))
|
||||||
@@ -137,29 +137,29 @@
|
|||||||
ticket-groups)))))
|
ticket-groups)))))
|
||||||
|
|
||||||
;; Assembled cart summary — replaces Python _cart_summary_sx
|
;; 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)
|
(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?))
|
||||||
(~cart-summary-panel
|
(~summary/panel
|
||||||
:item-count (str item-count)
|
:item-count (str item-count)
|
||||||
:subtotal (str symbol (format-decimal grand-total 2))
|
:subtotal (str symbol (format-decimal grand-total 2))
|
||||||
:checkout (if is-logged-in
|
:checkout (if is-logged-in
|
||||||
(~cart-checkout-form
|
(~summary/checkout-form
|
||||||
:action checkout-action :csrf (csrf-token)
|
:action checkout-action :csrf (csrf-token)
|
||||||
:label (str " Checkout as " user-email))
|
: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
|
;; 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)))
|
(if (and (empty? (or cart-items (list)))
|
||||||
(empty? (or cal-entries (list)))
|
(empty? (or cal-entries (list)))
|
||||||
(empty? (or ticket-groups (list))))
|
(empty? (or ticket-groups (list))))
|
||||||
(div :class "max-w-full px-3 py-3 space-y-3"
|
(div :class "max-w-full px-3 py-3 space-y-3"
|
||||||
(div :id "cart"
|
(div :id "cart"
|
||||||
(div :class "rounded-2xl border border-dashed border-stone-300 bg-white/80 p-6 sm:p-8 text-center"
|
(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"))))
|
||||||
(~cart-page-panel
|
(~items/page-panel
|
||||||
:items (map (lambda (item) (~cart-item-from-data :item item)) (or cart-items (list)))
|
:items (map (lambda (item) (~items/from-data :item item)) (or cart-items (list)))
|
||||||
:cal (when (not (empty? (or cal-entries (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))))
|
: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)))
|
:summary summary)))
|
||||||
|
|||||||
@@ -10,17 +10,17 @@
|
|||||||
(quasiquote
|
(quasiquote
|
||||||
(let ((__cpctx (cart-page-ctx)))
|
(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-href (get __cpctx "cart-url")
|
||||||
:link-label "cart" :icon "fa fa-shopping-cart"
|
:link-label "cart" :icon "fa fa-shopping-cart"
|
||||||
:child-id "cart-header-child")
|
:child-id "cart-header-child")
|
||||||
(~header-child-sx :id "cart-header-child"
|
(~shared:layout/header-child-sx :id "cart-header-child"
|
||||||
:inner (~menu-row-sx :id "page-cart-row" :level 2 :colour "sky"
|
:inner (~shared:layout/menu-row-sx :id "page-cart-row" :level 2 :colour "sky"
|
||||||
:link-href (get __cpctx "page-cart-url")
|
: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")
|
:feature-image (get __cpctx "feature-image")
|
||||||
:title (get __cpctx "title"))
|
: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)))))))
|
:oob (unquote oob)))))))
|
||||||
|
|
||||||
(defmacro ~cart-page-header-oob ()
|
(defmacro ~cart-page-header-oob ()
|
||||||
@@ -28,14 +28,14 @@
|
|||||||
(quasiquote
|
(quasiquote
|
||||||
(let ((__cpctx (cart-page-ctx)))
|
(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-href (get __cpctx "page-cart-url")
|
||||||
:link-label-content (~cart-page-label
|
:link-label-content (~header/page-label
|
||||||
:feature-image (get __cpctx "feature-image")
|
:feature-image (get __cpctx "feature-image")
|
||||||
:title (get __cpctx "title"))
|
: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)
|
: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-href (get __cpctx "cart-url")
|
||||||
:link-label "cart" :icon "fa fa-shopping-cart"
|
:link-label "cart" :icon "fa fa-shopping-cart"
|
||||||
:child-id "cart-header-child"
|
:child-id "cart-header-child"
|
||||||
@@ -45,12 +45,12 @@
|
|||||||
;; cart-page layout: root + cart row + page-cart row
|
;; cart-page layout: root + cart row + page-cart row
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~cart-page-layout-full ()
|
(defcomp ~layouts/page-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (~cart-page-header-auto))))
|
:inner (~cart-page-header-auto))))
|
||||||
|
|
||||||
(defcomp ~cart-page-layout-oob ()
|
(defcomp ~layouts/page-layout-oob ()
|
||||||
(<> (~cart-page-header-oob)
|
(<> (~cart-page-header-oob)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
@@ -59,14 +59,14 @@
|
|||||||
;; Uses (post-header-ctx) — requires :data handler to populate g._defpage_ctx
|
;; 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)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (~post-header-auto nil))))
|
:inner (~post-header-auto nil))))
|
||||||
|
|
||||||
(defcomp ~cart-admin-layout-oob (&key selected)
|
(defcomp ~layouts/admin-layout-oob (&key selected)
|
||||||
(<> (~post-header-auto true)
|
(<> (~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))
|
:row (~post-admin-header-auto nil selected))
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
@@ -74,63 +74,63 @@
|
|||||||
;; orders-within-cart: root + auth-simple + orders
|
;; 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)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (<> (~auth-header-row-simple-auto)
|
:inner (<> (~auth-header-row-simple-auto)
|
||||||
(~header-child-sx :id "auth-header-child"
|
(~shared:layout/header-child-sx :id "auth-header-child"
|
||||||
:inner (~orders-header-row :list-url list-url))))))
|
: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)
|
(<> (~auth-header-row-simple-auto true)
|
||||||
(~oob-header-sx
|
(~shared:layout/oob-header-sx
|
||||||
:parent-id "auth-header-child"
|
: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)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; order-detail-within-cart: root + auth-simple + orders + order
|
;; 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)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (<> (~auth-header-row-simple-auto)
|
:inner (<> (~auth-header-row-simple-auto)
|
||||||
(~header-child-sx :id "auth-header-child"
|
(~shared:layout/header-child-sx :id "auth-header-child"
|
||||||
:inner (<> (~orders-header-row :list-url list-url)
|
:inner (<> (~shared:auth/orders-header-row :list-url list-url)
|
||||||
(~header-child-sx :id "orders-header-child"
|
(~shared:layout/header-child-sx :id "orders-header-child"
|
||||||
:inner (~menu-row-sx :id "order-row" :level 3 :colour "sky"
|
:inner (~shared:layout/menu-row-sx :id "order-row" :level 3 :colour "sky"
|
||||||
:link-href detail-url
|
:link-href detail-url
|
||||||
:link-label order-label
|
:link-label order-label
|
||||||
:icon "fa fa-gbp"))))))))
|
:icon "fa fa-gbp"))))))))
|
||||||
|
|
||||||
(defcomp ~cart-order-detail-layout-oob (&key detail-url order-label)
|
(defcomp ~layouts/order-detail-layout-oob (&key detail-url order-label)
|
||||||
(<> (~oob-header-sx
|
(<> (~shared:layout/oob-header-sx
|
||||||
:parent-id "orders-header-child"
|
: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
|
:link-href detail-url :link-label order-label
|
||||||
:icon "fa fa-gbp" :oob true))
|
:icon "fa fa-gbp" :oob true))
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
;; --- orders rows wrapper (for infinite scroll) ---
|
;; --- 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))
|
(<> rows next-scroll))
|
||||||
|
|
||||||
;; Composition defcomp — replaces Python loop in render_orders_rows
|
;; Composition defcomp — replaces Python loop in render_orders_rows
|
||||||
(defcomp ~cart-orders-rows-content (&key orders detail-url-prefix page total-pages next-url)
|
(defcomp ~layouts/orders-rows-content (&key orders detail-url-prefix page total-pages next-url)
|
||||||
(~cart-orders-rows
|
(~layouts/orders-rows
|
||||||
:rows (map (lambda (od)
|
: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)))
|
(or orders (list)))
|
||||||
:next-scroll (if (< page total-pages)
|
: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)
|
: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
|
;; Composition defcomp — replaces conditional composition in render_checkout_error_page
|
||||||
(defcomp ~cart-checkout-error-from-data (&key msg order-id back-url)
|
(defcomp ~layouts/checkout-error-from-data (&key msg order-id back-url)
|
||||||
(~checkout-error-content
|
(~shared:orders/checkout-error-content
|
||||||
:msg msg
|
: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))
|
:back-url back-url))
|
||||||
|
|||||||
@@ -1,20 +1,20 @@
|
|||||||
;; Cart overview components
|
;; 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"
|
(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))
|
(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"
|
(div :class "mt-1 flex flex-wrap gap-2 text-xs text-stone-600"
|
||||||
badges))
|
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"))
|
(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))
|
(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"
|
(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"
|
(div :class "flex items-start gap-4"
|
||||||
img
|
img
|
||||||
@@ -25,7 +25,7 @@
|
|||||||
(div :class "text-lg font-bold text-stone-900" total)
|
(div :class "text-lg font-bold text-stone-900" total)
|
||||||
(div :class "mt-1 text-xs text-emerald-700 font-medium" "View cart \u2192")))))
|
(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 "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 "flex items-start gap-4"
|
||||||
(div :class "h-16 w-16 rounded-xl bg-amber-100 flex items-center justify-center flex-shrink-0"
|
(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-right flex-shrink-0"
|
||||||
(div :class "text-lg font-bold text-stone-900" total)))))
|
(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 "max-w-full px-3 py-3 space-y-3"
|
||||||
(div :class "space-y-4" cards)))
|
(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 "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"
|
(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
|
;; 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"))
|
(let* ((post (get grp "post"))
|
||||||
(product-count (or (get grp "product_count") 0))
|
(product-count (or (get grp "product_count") 0))
|
||||||
(calendar-count (or (get grp "calendar_count") 0))
|
(calendar-count (or (get grp "calendar_count") 0))
|
||||||
@@ -55,13 +55,13 @@
|
|||||||
(market-place (get grp "market_place"))
|
(market-place (get grp "market_place"))
|
||||||
(badges (<>
|
(badges (<>
|
||||||
(when (> product-count 0)
|
(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))))
|
:text (str product-count " item" (pluralize product-count))))
|
||||||
(when (> calendar-count 0)
|
(when (> calendar-count 0)
|
||||||
(~cart-badge :icon "fa fa-calendar"
|
(~overview/badge :icon "fa fa-calendar"
|
||||||
:text (str calendar-count " booking" (pluralize calendar-count))))
|
:text (str calendar-count " booking" (pluralize calendar-count))))
|
||||||
(when (> ticket-count 0)
|
(when (> ticket-count 0)
|
||||||
(~cart-badge :icon "fa fa-ticket"
|
(~overview/badge :icon "fa fa-ticket"
|
||||||
:text (str ticket-count " ticket" (pluralize ticket-count)))))))
|
:text (str ticket-count " ticket" (pluralize ticket-count)))))))
|
||||||
(if post
|
(if post
|
||||||
(let* ((slug (or (get post "slug") ""))
|
(let* ((slug (or (get post "slug") ""))
|
||||||
@@ -69,26 +69,26 @@
|
|||||||
(feature-image (get post "feature_image"))
|
(feature-image (get post "feature_image"))
|
||||||
(mp-name (if market-place (or (get market-place "name") "") ""))
|
(mp-name (if market-place (or (get market-place "name") "") ""))
|
||||||
(display-title (if (!= mp-name "") mp-name title)))
|
(display-title (if (!= mp-name "") mp-name title)))
|
||||||
(~cart-group-card
|
(~overview/group-card
|
||||||
:href (str cart-url-base "/" slug "/")
|
:href (str cart-url-base "/" slug "/")
|
||||||
:img (if feature-image
|
:img (if feature-image
|
||||||
(~cart-group-card-img :src feature-image :alt title)
|
(~overview/group-card-img :src feature-image :alt title)
|
||||||
(~img-or-placeholder :src nil :size-cls "h-16 w-16 rounded-xl"
|
(~shared:misc/img-or-placeholder :src nil :size-cls "h-16 w-16 rounded-xl"
|
||||||
:placeholder-icon "fa fa-store text-xl"))
|
:placeholder-icon "fa fa-store text-xl"))
|
||||||
:display-title display-title
|
:display-title display-title
|
||||||
:subtitle (when (!= mp-name "")
|
:subtitle (when (!= mp-name "")
|
||||||
(~cart-mp-subtitle :title title))
|
(~overview/mp-subtitle :title title))
|
||||||
:badges (~cart-badges-wrap :badges badges)
|
:badges (~overview/badges-wrap :badges badges)
|
||||||
:total (str "\u00a3" (format-decimal total 2))))
|
:total (str "\u00a3" (format-decimal total 2))))
|
||||||
(~cart-orphan-card
|
(~overview/orphan-card
|
||||||
:badges (~cart-badges-wrap :badges badges)
|
:badges (~overview/badges-wrap :badges badges)
|
||||||
:total (str "\u00a3" (format-decimal total 2))))))
|
:total (str "\u00a3" (format-decimal total 2))))))
|
||||||
|
|
||||||
;; Assembled cart overview content — replaces Python _overview_main_panel_sx
|
;; 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)
|
(if (empty? page-groups)
|
||||||
(~cart-empty)
|
(~overview/empty)
|
||||||
(~cart-overview-panel
|
(~overview/panel
|
||||||
:cards (map (lambda (grp)
|
: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))))
|
page-groups))))
|
||||||
|
|||||||
@@ -1,13 +1,13 @@
|
|||||||
;; Cart payments components
|
;; 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"
|
(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
|
:placeholder placeholder :input-cls input-cls :sumup-configured sumup-configured
|
||||||
:checkout-prefix checkout-prefix :sx-select "#payments-panel")))
|
:checkout-prefix checkout-prefix :sx-select "#payments-panel")))
|
||||||
|
|
||||||
;; Assembled cart admin overview content
|
;; Assembled cart admin overview content
|
||||||
(defcomp ~cart-admin-content ()
|
(defcomp ~payments/admin-content ()
|
||||||
(let* ((payments-href (url-for "defpage_cart_payments")))
|
(let* ((payments-href (url-for "defpage_cart_payments")))
|
||||||
(div :id "main-panel"
|
(div :id "main-panel"
|
||||||
(div :class "flex items-center justify-between p-3 border-b"
|
(div :class "flex items-center justify-between p-3 border-b"
|
||||||
@@ -15,13 +15,13 @@
|
|||||||
(a :href payments-href :class "text-sm underline" "configure")))))
|
(a :href payments-href :class "text-sm underline" "configure")))))
|
||||||
|
|
||||||
;; Assembled cart payments content
|
;; 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")))
|
(let* ((sumup-configured (and page-config (get page-config "sumup_api_key")))
|
||||||
(merchant-code (or (get page-config "sumup_merchant_code") ""))
|
(merchant-code (or (get page-config "sumup_merchant_code") ""))
|
||||||
(checkout-prefix (or (get page-config "sumup_checkout_prefix") ""))
|
(checkout-prefix (or (get page-config "sumup_checkout_prefix") ""))
|
||||||
(placeholder (if sumup-configured "--------" "sup_sk_..."))
|
(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"))
|
(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")
|
:update-url (url-for "page_admin.update_sumup")
|
||||||
:csrf (csrf-token)
|
:csrf (csrf-token)
|
||||||
:merchant-code merchant-code
|
:merchant-code merchant-code
|
||||||
|
|||||||
@@ -1,17 +1,17 @@
|
|||||||
;; Cart summary / checkout components
|
;; 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"
|
(form :method "post" :action action :class "w-full"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(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"
|
(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)))
|
(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"
|
(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"
|
(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"))))
|
(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"
|
(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"
|
(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")
|
(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
|
;; 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))
|
(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))
|
(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"
|
(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-1 min-w-0"
|
||||||
(div :class "flex flex-col sm:flex-row sm:items-start justify-between gap-2 sm:gap-3"
|
(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"
|
(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))))))
|
(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"
|
(div :class "mt-6 border-t border-stone-200 pt-4"
|
||||||
(h2 :class "text-base font-semibold mb-2"
|
(h2 :class "text-base font-semibold mb-2"
|
||||||
(i :class "fa fa-ticket mr-1" :aria-hidden "true") " Event tickets")
|
(i :class "fa fa-ticket mr-1" :aria-hidden "true") " Event tickets")
|
||||||
|
|||||||
@@ -6,7 +6,7 @@
|
|||||||
:auth :public
|
:auth :public
|
||||||
:layout :root
|
:layout :root
|
||||||
:data (service "cart-page" "overview-data")
|
:data (service "cart-page" "overview-data")
|
||||||
:content (~cart-overview-content
|
:content (~overview/content
|
||||||
:page-groups page-groups
|
:page-groups page-groups
|
||||||
:cart-url-base cart-url-base))
|
:cart-url-base cart-url-base))
|
||||||
|
|
||||||
@@ -15,11 +15,11 @@
|
|||||||
:auth :public
|
:auth :public
|
||||||
:layout :cart-page
|
:layout :cart-page
|
||||||
:data (service "cart-page" "page-cart-data")
|
:data (service "cart-page" "page-cart-data")
|
||||||
:content (~cart-page-cart-content
|
:content (~items/page-cart-content
|
||||||
:cart-items cart-items
|
:cart-items cart-items
|
||||||
:cal-entries cal-entries
|
:cal-entries cal-entries
|
||||||
:ticket-groups ticket-groups
|
:ticket-groups ticket-groups
|
||||||
:summary (~cart-summary-from-data
|
:summary (~items/summary-from-data
|
||||||
:item-count (get summary "item_count")
|
:item-count (get summary "item_count")
|
||||||
:grand-total (get summary "grand_total")
|
:grand-total (get summary "grand_total")
|
||||||
:symbol (get summary "symbol")
|
:symbol (get summary "symbol")
|
||||||
@@ -33,12 +33,12 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :cart-admin
|
:layout :cart-admin
|
||||||
:data (service "cart-page" "admin-data")
|
:data (service "cart-page" "admin-data")
|
||||||
:content (~cart-admin-content))
|
:content (~payments/admin-content))
|
||||||
|
|
||||||
(defpage cart-payments
|
(defpage cart-payments
|
||||||
:path "/<page_slug>/admin/payments/"
|
:path "/<page_slug>/admin/payments/"
|
||||||
:auth :admin
|
:auth :admin
|
||||||
:layout (:cart-admin :selected "payments")
|
:layout (:cart-admin :selected "payments")
|
||||||
:data (service "cart-page" "payments-admin-data")
|
:data (service "cart-page" "payments-admin-data")
|
||||||
:content (~cart-payments-content
|
:content (~payments/content
|
||||||
:page-config page-config))
|
: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]
|
order_dicts = [_serialize_order(o) for o in orders]
|
||||||
content = sx_call("orders-list-content", orders=order_dicts,
|
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)
|
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,
|
list_url=list_url,
|
||||||
)
|
)
|
||||||
filt = sx_call("order-list-header", search_mobile=await search_mobile_sx(ctx))
|
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]
|
order_dicts = [_serialize_order(o) for o in orders]
|
||||||
content = sx_call("orders-list-content", orders=order_dicts,
|
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)
|
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,
|
list_url=list_url,
|
||||||
)
|
)
|
||||||
filt = sx_call("order-list-header", search_mobile=await search_mobile_sx(ctx))
|
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)
|
main = sx_call("order-detail-content", order=order_data, calendar_entries=cal_data)
|
||||||
filt = sx_call("order-detail-filter-content", order=order_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())
|
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,
|
list_url=list_url, detail_url=detail_url,
|
||||||
order_label=f"Order {order.id}",
|
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)
|
main = sx_call("order-detail-content", order=order_data, calendar_entries=cal_data)
|
||||||
filt = sx_call("order-detail-filter-content", order=order_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())
|
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,
|
detail_url=detail_url,
|
||||||
order_label=f"Order {order.id}",
|
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.sx.helpers import sx_call, render_to_sx_with_env, full_page_sx
|
||||||
from shared.infrastructure.urls import cart_url
|
from shared.infrastructure.urls import cart_url
|
||||||
err_msg = error or "Unexpected error while creating the hosted checkout session."
|
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")
|
filt = sx_call("checkout-error-header")
|
||||||
content = sx_call("cart-checkout-error-from-data",
|
content = sx_call("cart-checkout-error-from-data",
|
||||||
msg=err_msg, order_id=order.id if order else None,
|
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 "Building: ${BUILD[*]}"
|
||||||
echo ""
|
echo ""
|
||||||
|
|
||||||
# --- Run unit tests before deploying ---
|
# --- Run unit tests before deploying (skip Playwright — needs running server) ---
|
||||||
echo "=== Running unit tests ==="
|
if ! QUICK=true ./run-tests.sh; then
|
||||||
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."
|
|
||||||
exit 1
|
exit 1
|
||||||
fi
|
fi
|
||||||
echo "Unit tests passed."
|
|
||||||
echo ""
|
|
||||||
|
|
||||||
for app in "${BUILD[@]}"; do
|
for app in "${BUILD[@]}"; do
|
||||||
dir=$(_app_dir "$app")
|
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"
|
WORKERS: "1"
|
||||||
SX_USE_REF: "1"
|
SX_USE_REF: "1"
|
||||||
SX_BOUNDARY_STRICT: "1"
|
SX_BOUNDARY_STRICT: "1"
|
||||||
|
SX_USE_OCAML: "1"
|
||||||
|
SX_OCAML_BIN: "/app/bin/sx_server"
|
||||||
|
|
||||||
x-sibling-models: &sibling-models
|
x-sibling-models: &sibling-models
|
||||||
# Every app needs all sibling __init__.py + models/ for cross-domain SQLAlchemy imports
|
# Every app needs all sibling __init__.py + models/ for cross-domain SQLAlchemy imports
|
||||||
@@ -44,6 +46,10 @@ services:
|
|||||||
volumes:
|
volumes:
|
||||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||||
- ./shared:/app/shared
|
- ./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.ini:/app/blog/alembic.ini:ro
|
||||||
- ./blog/alembic:/app/blog/alembic:ro
|
- ./blog/alembic:/app/blog/alembic:ro
|
||||||
- ./blog/app.py:/app/app.py
|
- ./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/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||||
- /root/rose-ash/_snapshot:/app/_snapshot
|
- /root/rose-ash/_snapshot:/app/_snapshot
|
||||||
- ./shared:/app/shared
|
- ./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.ini:/app/market/alembic.ini:ro
|
||||||
- ./market/alembic:/app/market/alembic:ro
|
- ./market/alembic:/app/market/alembic:ro
|
||||||
- ./market/app.py:/app/app.py
|
- ./market/app.py:/app/app.py
|
||||||
@@ -121,6 +131,10 @@ services:
|
|||||||
volumes:
|
volumes:
|
||||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||||
- ./shared:/app/shared
|
- ./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.ini:/app/cart/alembic.ini:ro
|
||||||
- ./cart/alembic:/app/cart/alembic:ro
|
- ./cart/alembic:/app/cart/alembic:ro
|
||||||
- ./cart/app.py:/app/app.py
|
- ./cart/app.py:/app/app.py
|
||||||
@@ -159,6 +173,10 @@ services:
|
|||||||
volumes:
|
volumes:
|
||||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||||
- ./shared:/app/shared
|
- ./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.ini:/app/events/alembic.ini:ro
|
||||||
- ./events/alembic:/app/events/alembic:ro
|
- ./events/alembic:/app/events/alembic:ro
|
||||||
- ./events/app.py:/app/app.py
|
- ./events/app.py:/app/app.py
|
||||||
@@ -197,6 +215,10 @@ services:
|
|||||||
volumes:
|
volumes:
|
||||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||||
- ./shared:/app/shared
|
- ./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.ini:/app/federation/alembic.ini:ro
|
||||||
- ./federation/alembic:/app/federation/alembic:ro
|
- ./federation/alembic:/app/federation/alembic:ro
|
||||||
- ./federation/app.py:/app/app.py
|
- ./federation/app.py:/app/app.py
|
||||||
@@ -235,6 +257,10 @@ services:
|
|||||||
volumes:
|
volumes:
|
||||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||||
- ./shared:/app/shared
|
- ./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.ini:/app/account/alembic.ini:ro
|
||||||
- ./account/alembic:/app/account/alembic:ro
|
- ./account/alembic:/app/account/alembic:ro
|
||||||
- ./account/app.py:/app/app.py
|
- ./account/app.py:/app/app.py
|
||||||
@@ -273,6 +299,10 @@ services:
|
|||||||
volumes:
|
volumes:
|
||||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||||
- ./shared:/app/shared
|
- ./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.ini:/app/relations/alembic.ini:ro
|
||||||
- ./relations/alembic:/app/relations/alembic:ro
|
- ./relations/alembic:/app/relations/alembic:ro
|
||||||
- ./relations/app.py:/app/app.py
|
- ./relations/app.py:/app/app.py
|
||||||
@@ -304,6 +334,10 @@ services:
|
|||||||
volumes:
|
volumes:
|
||||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||||
- ./shared:/app/shared
|
- ./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.ini:/app/likes/alembic.ini:ro
|
||||||
- ./likes/alembic:/app/likes/alembic:ro
|
- ./likes/alembic:/app/likes/alembic:ro
|
||||||
- ./likes/app.py:/app/app.py
|
- ./likes/app.py:/app/app.py
|
||||||
@@ -335,6 +369,10 @@ services:
|
|||||||
volumes:
|
volumes:
|
||||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||||
- ./shared:/app/shared
|
- ./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.ini:/app/orders/alembic.ini:ro
|
||||||
- ./orders/alembic:/app/orders/alembic:ro
|
- ./orders/alembic:/app/orders/alembic:ro
|
||||||
- ./orders/app.py:/app/app.py
|
- ./orders/app.py:/app/app.py
|
||||||
@@ -369,6 +407,10 @@ services:
|
|||||||
volumes:
|
volumes:
|
||||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||||
- ./shared:/app/shared
|
- ./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/app.py:/app/app.py
|
||||||
- ./test/sx:/app/sx
|
- ./test/sx:/app/sx
|
||||||
- ./test/bp:/app/bp
|
- ./test/bp:/app/bp
|
||||||
@@ -393,9 +435,14 @@ services:
|
|||||||
- "8012:8000"
|
- "8012:8000"
|
||||||
environment:
|
environment:
|
||||||
<<: *dev-env
|
<<: *dev-env
|
||||||
|
SX_STANDALONE: "true"
|
||||||
volumes:
|
volumes:
|
||||||
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
- /root/rose-ash/_config/app-config.yaml:/app/config/app-config.yaml:ro
|
||||||
- ./shared:/app/shared
|
- ./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/app.py:/app/app.py
|
||||||
- ./sx/sxc:/app/sxc
|
- ./sx/sxc:/app/sxc
|
||||||
- ./sx/bp:/app/bp
|
- ./sx/bp:/app/bp
|
||||||
@@ -431,6 +478,10 @@ services:
|
|||||||
dockerfile: test/Dockerfile.unit
|
dockerfile: test/Dockerfile.unit
|
||||||
volumes:
|
volumes:
|
||||||
- ./shared:/app/shared
|
- ./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/core:/app/artdag/core
|
||||||
- ./artdag/l1/tests:/app/artdag/l1/tests
|
- ./artdag/l1/tests:/app/artdag/l1/tests
|
||||||
- ./artdag/l1/sexp_effects:/app/artdag/l1/sexp_effects
|
- ./artdag/l1/sexp_effects:/app/artdag/l1/sexp_effects
|
||||||
@@ -456,6 +507,10 @@ services:
|
|||||||
dockerfile: test/Dockerfile.integration
|
dockerfile: test/Dockerfile.integration
|
||||||
volumes:
|
volumes:
|
||||||
- ./shared:/app/shared
|
- ./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
|
- ./artdag:/app/artdag
|
||||||
profiles:
|
profiles:
|
||||||
- test
|
- test
|
||||||
|
|||||||
@@ -58,6 +58,8 @@ x-app-env: &app-env
|
|||||||
EXTERNAL_INBOXES: "artdag|https://celery-artdag.rose-ash.com/inbox"
|
EXTERNAL_INBOXES: "artdag|https://celery-artdag.rose-ash.com/inbox"
|
||||||
SX_BOUNDARY_STRICT: "1"
|
SX_BOUNDARY_STRICT: "1"
|
||||||
SX_USE_REF: "1"
|
SX_USE_REF: "1"
|
||||||
|
SX_USE_OCAML: "1"
|
||||||
|
SX_OCAML_BIN: "/app/bin/sx_server"
|
||||||
|
|
||||||
services:
|
services:
|
||||||
blog:
|
blog:
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
;; Events admin components
|
;; 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"
|
(section :class "max-w-3xl mx-auto p-4 space-y-10"
|
||||||
(div
|
(div
|
||||||
(h2 :class "text-xl font-semibold" "Calendar configuration")
|
(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"))))
|
(div (button :class "px-3 py-2 rounded bg-stone-800 text-white" "Save"))))
|
||||||
(hr :class "border-stone-200")))
|
(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"
|
(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"))
|
(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 "flex flex-col mb-4"
|
||||||
(div :class "text-xs font-semibold uppercase tracking-wide text-stone-500" label)
|
(div :class "text-xs font-semibold uppercase tracking-wide text-stone-500" label)
|
||||||
content))
|
content))
|
||||||
|
|
||||||
(defcomp ~events-entry-name-field (&key name)
|
(defcomp ~admin/entry-name-field (&key name)
|
||||||
(div :class "mt-1 text-lg font-medium" 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"
|
(div :class "mt-1"
|
||||||
(span :class "px-2 py-1 rounded text-sm bg-blue-100 text-blue-700" slot-name)
|
(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)))
|
(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")))
|
(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))
|
(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)))
|
(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)))
|
(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))
|
(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))
|
(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))
|
(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)
|
tickets buy date posts options pre-action edit-url)
|
||||||
(section :id (str "entry-" entry-id) :class list-container
|
(section :id (str "entry-" entry-id) :class list-container
|
||||||
name slot time state cost
|
name slot time state cost
|
||||||
@@ -68,21 +68,21 @@
|
|||||||
:sx-get edit-url :sx-target (str "#entry-" entry-id) :sx-swap "outerHTML"
|
:sx-get edit-url :sx-target (str "#entry-" entry-id) :sx-swap "outerHTML"
|
||||||
"Edit"))))
|
"Edit"))))
|
||||||
|
|
||||||
(defcomp ~events-entry-title (&key name badge)
|
(defcomp ~admin/entry-title (&key name badge)
|
||||||
(<> (i :class "fa fa-clock") " " 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))
|
(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-title-" entry-id) :sx-swap-oob "innerHTML" title)
|
||||||
(div :id (str "entry-state-" entry-id) :sx-swap-oob "innerHTML" state)))
|
(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"
|
(div :id (str "calendar_entry_options_" entry-id) :class "flex flex-col md:flex-row gap-1"
|
||||||
buttons))
|
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)
|
label is-btn)
|
||||||
(form :sx-post url :sx-select target :sx-target target :sx-swap "outerHTML"
|
(form :sx-post url :sx-select target :sx-target target :sx-swap "outerHTML"
|
||||||
:sx-trigger (if is-btn "confirmed" nil)
|
:sx-trigger (if is-btn "confirmed" nil)
|
||||||
|
|||||||
@@ -1,34 +1,34 @@
|
|||||||
;; Events calendar components
|
;; 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
|
(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))
|
: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)))
|
(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))
|
(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))
|
(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"
|
(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))
|
: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)
|
(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 "truncate" name)
|
||||||
(span :class "shrink-0 text-[10px] font-semibold uppercase tracking-tight" state-label)))
|
(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 cell-cls
|
||||||
(div :class "flex justify-between items-center"
|
(div :class "flex justify-between items-center"
|
||||||
(div :class "flex flex-col" day-short day-num))
|
(div :class "flex flex-col" day-short day-num))
|
||||||
(div :class "mt-1 space-y-0.5" badges)))
|
(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"
|
(section :class "bg-orange-100"
|
||||||
(header :class "flex items-center justify-center mt-2"
|
(header :class "flex items-center justify-center mt-2"
|
||||||
(nav :class "flex items-center gap-2 text-2xl" arrows))
|
(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))))
|
(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
|
;; Calendar grid from data — all iteration in sx
|
||||||
(defcomp ~events-calendar-grid-from-data (&key pill-cls month-name year
|
(defcomp ~calendar/grid-from-data (&key (pill-cls :as string) (month-name :as string) (year :as string)
|
||||||
prev-year-href prev-month-href
|
(prev-year-href :as string) (prev-month-href :as string)
|
||||||
next-month-href next-year-href
|
(next-month-href :as string) (next-year-href :as string)
|
||||||
weekday-names cells)
|
(weekday-names :as list) (cells :as list))
|
||||||
(~events-calendar-grid
|
(~calendar/grid
|
||||||
:arrows (<>
|
:arrows (<>
|
||||||
(~events-calendar-nav-arrow :pill-cls pill-cls :href prev-year-href :label "\u00ab")
|
(~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")
|
(~calendar/nav-arrow :pill-cls pill-cls :href prev-month-href :label "\u2039")
|
||||||
(~events-calendar-month-label :month-name month-name :year year)
|
(~calendar/month-label :month-name month-name :year year)
|
||||||
(~events-calendar-nav-arrow :pill-cls pill-cls :href next-month-href :label "\u203a")
|
(~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"))
|
(~calendar/nav-arrow :pill-cls pill-cls :href next-year-href :label "\u00bb"))
|
||||||
:weekdays (<> (map (lambda (wd) (~events-calendar-weekday :name wd))
|
:weekdays (<> (map (lambda (wd) (~calendar/weekday :name wd))
|
||||||
(or weekday-names (list))))
|
(or weekday-names (list))))
|
||||||
:cells (<> (map (lambda (cell)
|
:cells (<> (map (lambda (cell)
|
||||||
(~events-calendar-cell
|
(~calendar/cell
|
||||||
:cell-cls (get cell "cell-cls")
|
:cell-cls (get cell "cell-cls")
|
||||||
:day-short (when (get cell "day-str")
|
: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")
|
: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")))
|
:href (get cell "day-href") :num (get cell "day-num")))
|
||||||
:badges (when (get cell "badges")
|
:badges (when (get cell "badges")
|
||||||
(<> (map (lambda (b)
|
(<> (map (lambda (b)
|
||||||
(~events-calendar-entry-badge
|
(~calendar/entry-badge
|
||||||
:bg-cls (get b "bg-cls") :name (get b "name")
|
:bg-cls (get b "bg-cls") :name (get b "name")
|
||||||
:state-label (get b "state-label")))
|
:state-label (get b "state-label")))
|
||||||
(get cell "badges"))))))
|
(get cell "badges"))))))
|
||||||
(or cells (list))))))
|
(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"
|
(div :id "calendar-description"
|
||||||
(if description
|
(if description
|
||||||
(p :class "text-stone-700 whitespace-pre-line break-all" 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"
|
:sx-get edit-url :sx-target "#calendar-description" :sx-swap "outerHTML"
|
||||||
(i :class "fas fa-edit"))))
|
(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"
|
(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"
|
:class "text-base font-normal break-words whitespace-normal min-w-0 break-all w-full text-center block"
|
||||||
description))
|
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"
|
(div :id "calendar-description"
|
||||||
(form :sx-post save-url :sx-target "#calendar-description" :sx-swap "outerHTML"
|
(form :sx-post save-url :sx-target "#calendar-description" :sx-swap "outerHTML"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||||
|
|||||||
@@ -1,18 +1,18 @@
|
|||||||
;; Events day components
|
;; 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"
|
(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 "flex-1 min-w-0"
|
||||||
(div :class "font-medium truncate" name)
|
(div :class "font-medium truncate" name)
|
||||||
(div :class "text-xs text-stone-600 truncate" time-str))))
|
(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"
|
(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"
|
:id "day-entries-nav-wrapper"
|
||||||
(div :class "flex overflow-x-auto gap-1 scrollbar-thin"
|
(div :class "flex overflow-x-auto gap-1 scrollbar-thin"
|
||||||
inner)))
|
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
|
(section :id "day-entries" :class list-container
|
||||||
(table :class "w-full text-sm border table-fixed"
|
(table :class "w-full text-sm border table-fixed"
|
||||||
(thead :class "bg-stone-100"
|
(thead :class "bg-stone-100"
|
||||||
@@ -29,95 +29,95 @@
|
|||||||
:sx-get add-url :sx-target "#entry-add-container" :sx-swap "innerHTML"
|
:sx-get add-url :sx-target "#entry-add-container" :sx-swap "innerHTML"
|
||||||
"+ Add entry"))))
|
"+ Add entry"))))
|
||||||
|
|
||||||
(defcomp ~events-day-empty-row ()
|
(defcomp ~day/empty-row ()
|
||||||
(tr (td :colspan "6" :class "p-3 text-stone-500" "No entries yet.")))
|
(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"
|
(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"
|
(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))))
|
: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"
|
(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"
|
(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)
|
:sx-swap "outerHTML" :sx-push-url "true" slot-name)
|
||||||
(span :class "text-stone-600 font-normal" time-str))))
|
(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))))
|
(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)))
|
(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)))
|
(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"
|
(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 "font-medium text-green-600" price-str)
|
||||||
(div :class "text-stone-600" count-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")))
|
(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"))
|
(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))
|
(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"))
|
(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"))
|
(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"
|
(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"
|
:id "day-entries-nav-wrapper" :sx-swap-oob "true"
|
||||||
(div :class "flex overflow-x-auto gap-1 scrollbar-thin" items)))
|
(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
|
(a :href href :class nav-btn
|
||||||
(div :class "flex-1 min-w-0"
|
(div :class "flex-1 min-w-0"
|
||||||
(div :class "font-medium truncate" name)
|
(div :class "font-medium truncate" name)
|
||||||
(div :class "text-xs text-stone-600 truncate" time-str))))
|
(div :class "text-xs text-stone-600 truncate" time-str))))
|
||||||
|
|
||||||
;; Day table from data — all row iteration in sx
|
;; 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)
|
(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?))
|
||||||
(~events-day-table
|
(~day/table
|
||||||
:list-container list-container
|
:list-container list-container
|
||||||
:rows (if (empty? (or rows (list)))
|
:rows (if (empty? (or rows (list)))
|
||||||
(~events-day-empty-row)
|
(~day/empty-row)
|
||||||
(<> (map (lambda (r)
|
(<> (map (lambda (r)
|
||||||
(~events-day-row
|
(~day/row
|
||||||
:tr-cls tr-cls
|
: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"))
|
:href (get r "href") :pill-cls pill-cls :name (get r "name"))
|
||||||
:slot (if (get r "slot-name")
|
:slot (if (get r "slot-name")
|
||||||
(~events-day-row-slot
|
(~day/row-slot
|
||||||
:href (get r "slot-href") :pill-cls pill-cls
|
:href (get r "slot-href") :pill-cls pill-cls
|
||||||
:slot-name (get r "slot-name") :time-str (get r "slot-time"))
|
:slot-name (get r "slot-name") :time-str (get r "slot-time"))
|
||||||
(~events-day-row-time :start (get r "start") :end (get r "end")))
|
(~day/row-time :start (get r "start") :end (get r "end")))
|
||||||
:state (~events-day-row-state
|
:state (~day/row-state
|
||||||
:state-id (get r "state-id")
|
:state-id (get r "state-id")
|
||||||
:badge (~entry-state-badge :state (get r "state")))
|
:badge (~entries/entry-state-badge :state (get r "state")))
|
||||||
:cost (~events-day-row-cost :cost-str (get r "cost-str"))
|
:cost (~day/row-cost :cost-str (get r "cost-str"))
|
||||||
:tickets (if (get r "has-tickets")
|
: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"))
|
:price-str (get r "price-str") :count-str (get r "count-str"))
|
||||||
(~events-day-row-no-tickets))
|
(~day/row-no-tickets))
|
||||||
:actions (~events-day-row-actions)))
|
:actions (~day/row-actions)))
|
||||||
(or rows (list)))))
|
(or rows (list)))))
|
||||||
:pre-action pre-action :add-url add-url))
|
:pre-action pre-action :add-url add-url))
|
||||||
|
|
||||||
;; Day entries nav OOB from data
|
;; 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)))
|
(if (empty? (or entries (list)))
|
||||||
(~events-day-entries-nav-oob-empty)
|
(~day/entries-nav-oob-empty)
|
||||||
(~events-day-entries-nav-oob
|
(~day/entries-nav-oob
|
||||||
:items (<> (map (lambda (e)
|
:items (<> (map (lambda (e)
|
||||||
(~events-day-nav-entry
|
(~day/nav-entry
|
||||||
:href (get e "href") :nav-btn nav-btn
|
:href (get e "href") :nav-btn nav-btn
|
||||||
:name (get e "name") :time-str (get e "time-str")))
|
:name (get e "name") :time-str (get e "time-str")))
|
||||||
entries)))))
|
entries)))))
|
||||||
|
|||||||
@@ -4,8 +4,8 @@
|
|||||||
;; State badges — cond maps state string to class + label
|
;; State badges — cond maps state string to class + label
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~entry-state-badge (&key state)
|
(defcomp ~entries/entry-state-badge (&key state)
|
||||||
(~badge
|
(~shared:misc/badge
|
||||||
:cls (cond
|
:cls (cond
|
||||||
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
||||||
((= state "provisional") "bg-amber-100 text-amber-800")
|
((= state "provisional") "bg-amber-100 text-amber-800")
|
||||||
@@ -21,7 +21,7 @@
|
|||||||
((= state "declined") "Declined")
|
((= state "declined") "Declined")
|
||||||
(true (or state "Unknown")))))
|
(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 "
|
(span :class (str "inline-flex items-center rounded-full px-3 py-1 text-sm font-medium "
|
||||||
(cond
|
(cond
|
||||||
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
||||||
@@ -38,8 +38,8 @@
|
|||||||
((= state "declined") "Declined")
|
((= state "declined") "Declined")
|
||||||
(true (or state "Unknown")))))
|
(true (or state "Unknown")))))
|
||||||
|
|
||||||
(defcomp ~ticket-state-badge (&key state)
|
(defcomp ~entries/ticket-state-badge (&key state)
|
||||||
(~badge
|
(~shared:misc/badge
|
||||||
:cls (cond
|
:cls (cond
|
||||||
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
||||||
((= state "checked_in") "bg-blue-100 text-blue-800")
|
((= state "checked_in") "bg-blue-100 text-blue-800")
|
||||||
@@ -53,7 +53,7 @@
|
|||||||
((= state "cancelled") "Cancelled")
|
((= state "cancelled") "Cancelled")
|
||||||
(true (or state "Unknown")))))
|
(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 "
|
(span :class (str "inline-flex items-center rounded-full px-3 py-1 text-sm font-medium "
|
||||||
(cond
|
(cond
|
||||||
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
((= state "confirmed") "bg-emerald-100 text-emerald-800")
|
||||||
@@ -73,36 +73,36 @@
|
|||||||
;; Entry card components
|
;; 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"
|
(a :href href :class "hover:text-emerald-700"
|
||||||
(h2 :class "text-lg font-semibold text-stone-900" name)))
|
(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))
|
(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"
|
(a :href href :class "hover:text-emerald-700"
|
||||||
(h2 :class "text-base font-semibold text-stone-900 line-clamp-2" name)))
|
(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))
|
(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))
|
(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))
|
(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) " · "))
|
(<> (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) " · "))
|
(<> (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))
|
(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"
|
(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 flex-col sm:flex-row sm:items-start justify-between gap-3"
|
||||||
(div :class "flex-1 min-w-0"
|
(div :class "flex-1 min-w-0"
|
||||||
@@ -112,7 +112,7 @@
|
|||||||
cost)
|
cost)
|
||||||
widget)))
|
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"
|
(article :class "rounded-xl bg-white shadow-sm border border-stone-200 overflow-hidden"
|
||||||
(div :class "p-3"
|
(div :class "p-3"
|
||||||
title
|
title
|
||||||
@@ -121,20 +121,20 @@
|
|||||||
cost)
|
cost)
|
||||||
widget))
|
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))
|
(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))
|
(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"
|
(div :class "pt-2 pb-1"
|
||||||
(h3 :class "text-sm font-semibold text-stone-500 uppercase tracking-wide" date-str)))
|
(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))
|
(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")))
|
(<> toggle body (div :class "pb-8")))
|
||||||
|
|
||||||
|
|
||||||
@@ -143,46 +143,46 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
;; Ticket widget from data — replaces _ticket_widget_html Python composition
|
;; Ticket widget from data — replaces _ticket_widget_html Python composition
|
||||||
(defcomp ~events-tw-widget-from-data (&key entry-id price qty ticket-url csrf)
|
(defcomp ~entries/tw-widget-from-data (&key entry-id price qty ticket-url csrf)
|
||||||
(~events-tw-widget :entry-id (str entry-id) :price price
|
(~page/tw-widget :entry-id (str entry-id) :price price
|
||||||
:inner (if (= (or qty 0) 0)
|
: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"
|
: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))
|
:csrf csrf :entry-id (str entry-id) :count-val (str (- qty 1))
|
||||||
:btn (~events-tw-minus))
|
:btn (~page/tw-minus))
|
||||||
(~events-tw-cart-icon :qty (str qty))
|
(~page/tw-cart-icon :qty (str qty))
|
||||||
(~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))
|
: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
|
;; 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
|
page-badge-href page-badge-title cal-name
|
||||||
date-str start-time end-time is-page-scoped
|
date-str start-time end-time is-page-scoped
|
||||||
cost has-ticket ticket-data)
|
cost has-ticket ticket-data)
|
||||||
(~events-entry-card
|
(~entries/entry-card
|
||||||
:title (if entry-href
|
:title (if entry-href
|
||||||
(~events-entry-title-linked :href entry-href :name name)
|
(~entries/entry-title-linked :href entry-href :name name)
|
||||||
(~events-entry-title-plain :name name))
|
(~entries/entry-title-plain :name name))
|
||||||
:badges (<>
|
:badges (<>
|
||||||
(when page-badge-title
|
(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
|
(when cal-name
|
||||||
(~events-entry-cal-badge :name cal-name)))
|
(~entries/entry-cal-badge :name cal-name)))
|
||||||
:time-parts (<>
|
:time-parts (<>
|
||||||
(when (and day-href (not is-page-scoped))
|
(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)
|
(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
|
start-time
|
||||||
(when end-time (str " \u2013 " end-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
|
:widget (when has-ticket
|
||||||
(~events-entry-widget-wrapper
|
(~entries/entry-widget-wrapper
|
||||||
:widget (~events-tw-widget-from-data
|
:widget (~entries/tw-widget-from-data
|
||||||
:entry-id (get ticket-data "entry-id")
|
:entry-id (get ticket-data "entry-id")
|
||||||
:price (get ticket-data "price")
|
:price (get ticket-data "price")
|
||||||
:qty (get ticket-data "qty")
|
:qty (get ticket-data "qty")
|
||||||
@@ -190,24 +190,24 @@
|
|||||||
:csrf (get ticket-data "csrf"))))))
|
:csrf (get ticket-data "csrf"))))))
|
||||||
|
|
||||||
;; Entry card (tile view) from data
|
;; 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
|
page-badge-href page-badge-title cal-name
|
||||||
date-str time-str
|
date-str time-str
|
||||||
cost has-ticket ticket-data)
|
cost has-ticket ticket-data)
|
||||||
(~events-entry-card-tile
|
(~entries/entry-card-tile
|
||||||
:title (if entry-href
|
:title (if entry-href
|
||||||
(~events-entry-title-tile-linked :href entry-href :name name)
|
(~entries/entry-title-tile-linked :href entry-href :name name)
|
||||||
(~events-entry-title-tile-plain :name name))
|
(~entries/entry-title-tile-plain :name name))
|
||||||
:badges (<>
|
:badges (<>
|
||||||
(when page-badge-title
|
(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
|
(when cal-name
|
||||||
(~events-entry-cal-badge :name cal-name)))
|
(~entries/entry-cal-badge :name cal-name)))
|
||||||
:time time-str
|
:time time-str
|
||||||
:cost (when cost (~events-entry-cost :cost cost))
|
:cost (when cost (~entries/entry-cost :cost cost))
|
||||||
:widget (when has-ticket
|
:widget (when has-ticket
|
||||||
(~events-entry-tile-widget-wrapper
|
(~entries/entry-tile-widget-wrapper
|
||||||
:widget (~events-tw-widget-from-data
|
:widget (~entries/tw-widget-from-data
|
||||||
:entry-id (get ticket-data "entry-id")
|
:entry-id (get ticket-data "entry-id")
|
||||||
:price (get ticket-data "price")
|
:price (get ticket-data "price")
|
||||||
:qty (get ticket-data "qty")
|
:qty (get ticket-data "qty")
|
||||||
@@ -215,13 +215,13 @@
|
|||||||
:csrf (get ticket-data "csrf"))))))
|
:csrf (get ticket-data "csrf"))))))
|
||||||
|
|
||||||
;; Entry cards list (with date separators + sentinel) from data
|
;; 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)
|
(map (lambda (item)
|
||||||
(if (get item "is-separator")
|
(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")
|
(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")
|
:entry-href (get item "entry-href") :name (get item "name")
|
||||||
:day-href (get item "day-href")
|
:day-href (get item "day-href")
|
||||||
:page-badge-href (get item "page-badge-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")
|
:date-str (get item "date-str") :time-str (get item "time-str")
|
||||||
:cost (get item "cost") :has-ticket (get item "has-ticket")
|
:cost (get item "cost") :has-ticket (get item "has-ticket")
|
||||||
:ticket-data (get item "ticket-data"))
|
: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")
|
:entry-href (get item "entry-href") :name (get item "name")
|
||||||
:day-href (get item "day-href")
|
:day-href (get item "day-href")
|
||||||
:page-badge-href (get item "page-badge-href")
|
:page-badge-href (get item "page-badge-href")
|
||||||
@@ -243,20 +243,20 @@
|
|||||||
:ticket-data (get item "ticket-data")))))
|
:ticket-data (get item "ticket-data")))))
|
||||||
(or items (list)))
|
(or items (list)))
|
||||||
(when has-more
|
(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
|
;; Events main panel (toggle + cards grid) from data
|
||||||
(defcomp ~events-main-panel-from-data (&key toggle items view page has-more next-url)
|
(defcomp ~entries/main-panel-from-data (&key toggle items view page has-more next-url)
|
||||||
(~events-main-panel-body
|
(~entries/main-panel-body
|
||||||
:toggle toggle
|
:toggle toggle
|
||||||
:body (if items
|
:body (if items
|
||||||
(~events-grid
|
(~entries/grid
|
||||||
:grid-cls (if (= view "tile")
|
: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 grid grid-cols-1 sm:grid-cols-2 md:grid-cols-3 gap-4"
|
||||||
"max-w-full px-3 py-3 space-y-3")
|
"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
|
:items items :view view :page page
|
||||||
:has-more has-more :next-url next-url))
|
: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"
|
:message "No upcoming events"
|
||||||
:cls "px-3 py-12 text-center text-stone-400"))))
|
:cls "px-3 py-12 text-center text-stone-400"))))
|
||||||
|
|||||||
@@ -5,25 +5,25 @@
|
|||||||
;; Slot picker option (shared by entry-edit and entry-add)
|
;; 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
|
(option :value value :data-start data-start :data-end data-end
|
||||||
:data-flexible data-flexible :data-cost data-cost
|
:data-flexible data-flexible :data-cost data-cost
|
||||||
:selected selected
|
:selected selected
|
||||||
label))
|
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"
|
(select :id id :name "slot_id" :class "w-full border p-2 rounded"
|
||||||
:data-slot-picker "" :required "required"
|
:data-slot-picker "" :required "required"
|
||||||
options))
|
options))
|
||||||
|
|
||||||
(defcomp ~events-no-slots ()
|
(defcomp ~forms/no-slots ()
|
||||||
(div :class "text-sm text-stone-500" "No slots defined for this day."))
|
(div :class "text-sm text-stone-500" "No slots defined for this day."))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Entry edit form (_types/entry/_edit.html)
|
;; 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
|
name-val slot-picker
|
||||||
start-val end-val cost-display
|
start-val end-val cost-display
|
||||||
ticket-price-val ticket-count-val
|
ticket-price-val ticket-count-val
|
||||||
@@ -115,7 +115,7 @@
|
|||||||
;; Post search results (_types/entry/_post_search_results.html)
|
;; 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)
|
img title)
|
||||||
(form :sx-post post-url :sx-target (str "#entry-posts-" entry-id) :sx-swap "innerHTML"
|
(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"
|
:class "p-2 hover:bg-stone-50 cursor-pointer rounded text-sm border-b"
|
||||||
@@ -129,7 +129,7 @@
|
|||||||
:data-confirm-cancel-text "Cancel"
|
:data-confirm-cancel-text "Cancel"
|
||||||
img (span title))))
|
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)
|
(div :id (str "post-search-sentinel-" page)
|
||||||
:sx-get next-url
|
:sx-get next-url
|
||||||
:sx-trigger "intersect once delay:250ms, sentinel:retry"
|
: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-loading" "Loading more...")
|
||||||
(div :class "text-xs text-center text-stone-400 js-neterr hidden" "Connection error. Retrying...")))
|
(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"))
|
(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)
|
;; 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"
|
(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)
|
(input :type "checkbox" :name name :value "1" :data-day name :checked checked)
|
||||||
(span label)))
|
(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"
|
(label :class "flex items-center gap-1 px-2 py-1 rounded-full bg-slate-200"
|
||||||
(input :type "checkbox" :data-day-all "" :checked checked)
|
(input :type "checkbox" :data-day-all "" :checked checked)
|
||||||
(span "All")))
|
(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
|
name-val cost-val start-val end-val desc-val
|
||||||
days flexible-checked
|
days flexible-checked
|
||||||
action-btn cancel-btn)
|
action-btn cancel-btn)
|
||||||
@@ -271,7 +271,7 @@
|
|||||||
;; Slot add form (_types/slots/_add.html)
|
;; 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"
|
(form :sx-post post-url :sx-target "#slots-table" :sx-select "#slots-table"
|
||||||
:sx-disinherit "sx-select" :sx-swap "outerHTML"
|
:sx-disinherit "sx-select" :sx-swap "outerHTML"
|
||||||
:sx-headers csrf :class "space-y-3"
|
:sx-headers csrf :class "space-y-3"
|
||||||
@@ -312,7 +312,7 @@
|
|||||||
:data-confirm-cancel-text "Cancel"
|
:data-confirm-cancel-text "Cancel"
|
||||||
(i :class "fa fa-save") " Save slot"))))
|
(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
|
(button :type "button" :class pre-action
|
||||||
:sx-get add-url :sx-target "#slot-add-container" :sx-swap "innerHTML"
|
:sx-get add-url :sx-target "#slot-add-container" :sx-swap "innerHTML"
|
||||||
"+ Add slot"))
|
"+ Add slot"))
|
||||||
@@ -323,20 +323,20 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
;; Day checkboxes from data — replaces Python loop
|
;; 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)
|
(map (lambda (d)
|
||||||
(~events-day-checkbox
|
(~forms/day-checkbox
|
||||||
:name (get d "name")
|
:name (get d "name")
|
||||||
:label (get d "label")
|
:label (get d "label")
|
||||||
:checked (when (get d "checked") "checked")))
|
:checked (when (get d "checked") "checked")))
|
||||||
(or days-data (list)))))
|
(or days-data (list)))))
|
||||||
|
|
||||||
;; Slot options from data — replaces _slot_options_html Python loop
|
;; 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)
|
(<> (map (lambda (s)
|
||||||
(~events-slot-option
|
(~forms/slot-option
|
||||||
:value (get s "value")
|
:value (get s "value")
|
||||||
:data-start (get s "data-start")
|
:data-start (get s "data-start")
|
||||||
:data-end (get s "data-end")
|
:data-end (get s "data-end")
|
||||||
@@ -347,32 +347,32 @@
|
|||||||
(or slots (list)))))
|
(or slots (list)))))
|
||||||
|
|
||||||
;; Slot picker from data — wraps picker + options
|
;; 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)))
|
(if (empty? (or slots (list)))
|
||||||
(~events-no-slots)
|
(~forms/no-slots)
|
||||||
(~events-slot-picker
|
(~forms/slot-picker
|
||||||
:id id
|
:id id
|
||||||
:options (~events-slot-options-from-data :slots slots))))
|
:options (~forms/slot-options-from-data :slots slots))))
|
||||||
|
|
||||||
;; Slot edit form from data
|
;; 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
|
name-val cost-val start-val end-val desc-val
|
||||||
days-data all-checked flexible-checked
|
days-data all-checked flexible-checked
|
||||||
action-btn cancel-btn)
|
action-btn cancel-btn)
|
||||||
(~events-slot-edit-form
|
(~forms/slot-edit-form
|
||||||
:slot-id slot-id :list-container list-container
|
:slot-id slot-id :list-container list-container
|
||||||
:put-url put-url :cancel-url cancel-url :csrf csrf
|
:put-url put-url :cancel-url cancel-url :csrf csrf
|
||||||
:name-val name-val :cost-val cost-val :start-val start-val
|
:name-val name-val :cost-val cost-val :start-val start-val
|
||||||
:end-val end-val :desc-val desc-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
|
:flexible-checked flexible-checked
|
||||||
:action-btn action-btn :cancel-btn cancel-btn))
|
:action-btn action-btn :cancel-btn cancel-btn))
|
||||||
|
|
||||||
;; Slot add form from data
|
;; Slot add form from data
|
||||||
(defcomp ~events-slot-add-form-from-data (&key post-url csrf days-data action-btn cancel-btn cancel-url)
|
(defcomp ~forms/slot-add-form-from-data (&key post-url csrf days-data action-btn cancel-btn cancel-url)
|
||||||
(~events-slot-add-form
|
(~forms/slot-add-form
|
||||||
:post-url post-url :csrf csrf
|
: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))
|
:action-btn action-btn :cancel-btn cancel-btn :cancel-url cancel-url))
|
||||||
|
|
||||||
|
|
||||||
@@ -380,7 +380,7 @@
|
|||||||
;; Entry add form (_types/day/_add.html)
|
;; 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)
|
action-btn cancel-btn cancel-url)
|
||||||
(<>
|
(<>
|
||||||
(div :id "entry-errors" :class "mt-2 text-sm text-red-600")
|
(div :id "entry-errors" :class "mt-2 text-sm text-red-600")
|
||||||
@@ -446,7 +446,7 @@
|
|||||||
:data-confirm-cancel-text "Cancel"
|
:data-confirm-cancel-text "Cancel"
|
||||||
(i :class "fa fa-save") " Save entry")))))
|
(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
|
(button :type "button" :class pre-action
|
||||||
:sx-get add-url :sx-target "#entry-add-container" :sx-swap "innerHTML"
|
:sx-get add-url :sx-target "#entry-add-container" :sx-swap "innerHTML"
|
||||||
"+ Add entry"))
|
"+ Add entry"))
|
||||||
@@ -456,7 +456,7 @@
|
|||||||
;; Ticket type edit form (_types/ticket_type/_edit.html)
|
;; 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
|
name-val cost-val count-val
|
||||||
action-btn cancel-btn)
|
action-btn cancel-btn)
|
||||||
(section :id (str "ticket-" ticket-id) :class list-container
|
(section :id (str "ticket-" ticket-id) :class list-container
|
||||||
@@ -509,7 +509,7 @@
|
|||||||
;; Ticket type add form (_types/ticket_types/_add.html)
|
;; 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"
|
(form :sx-post post-url :sx-target "#tickets-table" :sx-select "#tickets-table"
|
||||||
:sx-disinherit "sx-select" :sx-swap "outerHTML"
|
:sx-disinherit "sx-select" :sx-swap "outerHTML"
|
||||||
:sx-headers csrf :class "space-y-3"
|
:sx-headers csrf :class "space-y-3"
|
||||||
@@ -540,7 +540,7 @@
|
|||||||
:data-confirm-cancel-text "Cancel"
|
:data-confirm-cancel-text "Cancel"
|
||||||
(i :class "fa fa-save") " Save ticket type"))))
|
(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
|
(button :class action-btn
|
||||||
:sx-get add-url :sx-target "#ticket-add-container" :sx-swap "innerHTML"
|
:sx-get add-url :sx-target "#ticket-add-container" :sx-swap "innerHTML"
|
||||||
(i :class "fa fa-plus") " Add ticket type"))
|
(i :class "fa fa-plus") " Add ticket type"))
|
||||||
@@ -550,6 +550,6 @@
|
|||||||
;; Entry admin nav — placeholder
|
;; Entry admin nav — placeholder
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~events-admin-placeholder-nav ()
|
(defcomp ~forms/admin-placeholder-nav ()
|
||||||
(div :class "relative nav-group"
|
(div :class "relative nav-group"
|
||||||
(span :class "block px-3 py-2 text-stone-400 text-sm italic" "Admin options")))
|
(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)
|
;; 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
|
(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]"
|
: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 "font-medium text-stone-900 truncate" name)
|
||||||
(div :class "text-xs text-stone-600" date-str)
|
(div :class "text-xs text-stone-600" date-str)
|
||||||
(div :class "text-xs text-stone-500" time-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"
|
(div :class "mt-4 mb-2"
|
||||||
(h3 :class "text-sm font-semibold text-stone-700 mb-2 px-2" "Events:")
|
(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;"
|
(div :class "overflow-x-auto scrollbar-hide" :style "scroll-behavior: smooth;"
|
||||||
@@ -23,7 +23,7 @@
|
|||||||
;; Account page tickets (fragments/account_page_tickets.html)
|
;; 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 "py-4 first:pt-0 last:pb-0"
|
||||||
(div :class "flex items-start justify-between gap-4"
|
(div :class "flex items-start justify-between gap-4"
|
||||||
(div :class "min-w-0 flex-1"
|
(div :class "min-w-0 flex-1"
|
||||||
@@ -35,13 +35,13 @@
|
|||||||
type-name))
|
type-name))
|
||||||
(div :class "flex-shrink-0" badge))))
|
(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 "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"
|
(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")
|
(h1 :class "text-xl font-semibold tracking-tight" "Tickets")
|
||||||
items)))
|
items)))
|
||||||
|
|
||||||
(defcomp ~events-frag-tickets-list (&key items)
|
(defcomp ~fragments/frag-tickets-list (&key items)
|
||||||
(div :class "divide-y divide-stone-100" items))
|
(div :class "divide-y divide-stone-100" items))
|
||||||
|
|
||||||
|
|
||||||
@@ -49,7 +49,7 @@
|
|||||||
;; Account page bookings (fragments/account_page_bookings.html)
|
;; 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 "py-4 first:pt-0 last:pb-0"
|
||||||
(div :class "flex items-start justify-between gap-4"
|
(div :class "flex items-start justify-between gap-4"
|
||||||
(div :class "min-w-0 flex-1"
|
(div :class "min-w-0 flex-1"
|
||||||
@@ -60,13 +60,13 @@
|
|||||||
cost-str))
|
cost-str))
|
||||||
(div :class "flex-shrink-0" badge))))
|
(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 "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"
|
(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")
|
(h1 :class "text-xl font-semibold tracking-tight" "Bookings")
|
||||||
items)))
|
items)))
|
||||||
|
|
||||||
(defcomp ~events-frag-bookings-list (&key items)
|
(defcomp ~fragments/frag-bookings-list (&key items)
|
||||||
(div :class "divide-y divide-stone-100" items))
|
(div :class "divide-y divide-stone-100" items))
|
||||||
|
|
||||||
|
|
||||||
@@ -75,12 +75,12 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
;; Container cards: list of widgets, each with entries
|
;; 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)
|
(<> (map (lambda (w)
|
||||||
(if (get w "entries")
|
(if (get w "entries")
|
||||||
(~events-frag-entries-widget
|
(~fragments/frag-entries-widget
|
||||||
:cards (<> (map (lambda (e)
|
:cards (<> (map (lambda (e)
|
||||||
(~events-frag-entry-card
|
(~fragments/frag-entry-card
|
||||||
:href (get e "href") :name (get e "name")
|
:href (get e "href") :name (get e "name")
|
||||||
:date-str (get e "date-str") :time-str (get e "time-str")))
|
:date-str (get e "date-str") :time-str (get e "time-str")))
|
||||||
(get w "entries"))))
|
(get w "entries"))))
|
||||||
@@ -88,43 +88,43 @@
|
|||||||
(or widgets (list)))))
|
(or widgets (list)))))
|
||||||
|
|
||||||
;; Ticket item from data — composes badge + optional spans
|
;; 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)
|
(defcomp ~fragments/frag-ticket-item-from-data (&key href entry-name date-str calendar-name type-name state)
|
||||||
(~events-frag-ticket-item
|
(~fragments/frag-ticket-item
|
||||||
:href href :entry-name entry-name :date-str date-str
|
:href href :entry-name entry-name :date-str date-str
|
||||||
:calendar-name (when calendar-name (span "\u00b7 " calendar-name))
|
:calendar-name (when calendar-name (span "\u00b7 " calendar-name))
|
||||||
:type-name (when type-name (span "\u00b7 " type-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
|
;; Tickets panel from data — full panel with list iteration
|
||||||
(defcomp ~events-frag-tickets-panel-from-data (&key tickets)
|
(defcomp ~fragments/frag-tickets-panel-from-data (&key tickets)
|
||||||
(~events-frag-tickets-panel
|
(~fragments/frag-tickets-panel
|
||||||
:items (if (empty? (or tickets (list)))
|
:items (if (empty? (or tickets (list)))
|
||||||
(~empty-state :message "No tickets yet." :cls "text-sm text-stone-500")
|
(~shared:misc/empty-state :message "No tickets yet." :cls "text-sm text-stone-500")
|
||||||
(~events-frag-tickets-list
|
(~fragments/frag-tickets-list
|
||||||
:items (<> (map (lambda (t)
|
: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")
|
:href (get t "href") :entry-name (get t "entry-name")
|
||||||
:date-str (get t "date-str") :calendar-name (get t "calendar-name")
|
:date-str (get t "date-str") :calendar-name (get t "calendar-name")
|
||||||
:type-name (get t "type-name") :state (get t "state")))
|
:type-name (get t "type-name") :state (get t "state")))
|
||||||
tickets))))))
|
tickets))))))
|
||||||
|
|
||||||
;; Booking item from data — composes badge + optional spans
|
;; 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)
|
(defcomp ~fragments/frag-booking-item-from-data (&key name date-str end-time calendar-name cost-str state)
|
||||||
(~events-frag-booking-item
|
(~fragments/frag-booking-item
|
||||||
:name name
|
:name name
|
||||||
:date-str (<> date-str (when end-time (span "\u2013 " end-time)))
|
:date-str (<> date-str (when end-time (span "\u2013 " end-time)))
|
||||||
:calendar-name (when calendar-name (span "\u00b7 " calendar-name))
|
:calendar-name (when calendar-name (span "\u00b7 " calendar-name))
|
||||||
:cost-str (when cost-str (span "\u00b7 \u00a3" cost-str))
|
: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
|
;; Bookings panel from data — full panel with list iteration
|
||||||
(defcomp ~events-frag-bookings-panel-from-data (&key bookings)
|
(defcomp ~fragments/frag-bookings-panel-from-data (&key bookings)
|
||||||
(~events-frag-bookings-panel
|
(~fragments/frag-bookings-panel
|
||||||
:items (if (empty? (or bookings (list)))
|
:items (if (empty? (or bookings (list)))
|
||||||
(~empty-state :message "No bookings yet." :cls "text-sm text-stone-500")
|
(~shared:misc/empty-state :message "No bookings yet." :cls "text-sm text-stone-500")
|
||||||
(~events-frag-bookings-list
|
(~fragments/frag-bookings-list
|
||||||
:items (<> (map (lambda (b)
|
:items (<> (map (lambda (b)
|
||||||
(~events-frag-booking-item-from-data
|
(~fragments/frag-booking-item-from-data
|
||||||
:href (get b "href") :name (get b "name")
|
:href (get b "href") :name (get b "name")
|
||||||
:date-str (get b "date-str") :end-time (get b "end-time")
|
:date-str (get b "date-str") :end-time (get b "end-time")
|
||||||
:calendar-name (get b "calendar-name") :cost-str (get b "cost-str")
|
:calendar-name (get b "calendar-name") :cost-str (get b "cost-str")
|
||||||
|
|||||||
@@ -8,12 +8,12 @@
|
|||||||
(nav-class (or (get styles "nav_button") ""))
|
(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"))
|
(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/")
|
:href (app-url "account" "/tickets/")
|
||||||
:hx-select hx-select
|
:hx-select hx-select
|
||||||
:nav-class nav-class
|
:nav-class nav-class
|
||||||
:label "tickets")
|
:label "tickets")
|
||||||
(~nav-group-link
|
(~shared:misc/nav-group-link
|
||||||
:href (app-url "account" "/bookings/")
|
:href (app-url "account" "/bookings/")
|
||||||
:hx-select hx-select
|
:hx-select hx-select
|
||||||
:nav-class nav-class
|
:nav-class nav-class
|
||||||
|
|||||||
@@ -10,13 +10,13 @@
|
|||||||
(cond
|
(cond
|
||||||
(= slug "tickets")
|
(= slug "tickets")
|
||||||
(let ((tickets (service "calendar" "user-tickets" :user-id uid)))
|
(let ((tickets (service "calendar" "user-tickets" :user-id uid)))
|
||||||
(~events-frag-tickets-panel
|
(~fragments/frag-tickets-panel
|
||||||
:items (if (empty? tickets)
|
:items (if (empty? tickets)
|
||||||
(~empty-state :message "No tickets yet."
|
(~shared:misc/empty-state :message "No tickets yet."
|
||||||
:cls "text-sm text-stone-500")
|
:cls "text-sm text-stone-500")
|
||||||
(~events-frag-tickets-list
|
(~fragments/frag-tickets-list
|
||||||
:items (<> (map (fn (t)
|
:items (<> (map (fn (t)
|
||||||
(~events-frag-ticket-item
|
(~fragments/frag-ticket-item
|
||||||
:href (app-url "events"
|
:href (app-url "events"
|
||||||
(str "/tickets/" (get t "code") "/"))
|
(str "/tickets/" (get t "code") "/"))
|
||||||
:entry-name (get t "entry_name")
|
:entry-name (get t "entry_name")
|
||||||
@@ -25,18 +25,18 @@
|
|||||||
(span (str "\u00b7 " (get t "calendar_name"))))
|
(span (str "\u00b7 " (get t "calendar_name"))))
|
||||||
:type-name (when (get t "ticket_type_name")
|
:type-name (when (get t "ticket_type_name")
|
||||||
(span (str "\u00b7 " (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))))))
|
tickets))))))
|
||||||
|
|
||||||
(= slug "bookings")
|
(= slug "bookings")
|
||||||
(let ((bookings (service "calendar" "user-bookings" :user-id uid)))
|
(let ((bookings (service "calendar" "user-bookings" :user-id uid)))
|
||||||
(~events-frag-bookings-panel
|
(~fragments/frag-bookings-panel
|
||||||
:items (if (empty? bookings)
|
:items (if (empty? bookings)
|
||||||
(~empty-state :message "No bookings yet."
|
(~shared:misc/empty-state :message "No bookings yet."
|
||||||
:cls "text-sm text-stone-500")
|
:cls "text-sm text-stone-500")
|
||||||
(~events-frag-bookings-list
|
(~fragments/frag-bookings-list
|
||||||
:items (<> (map (fn (b)
|
:items (<> (map (fn (b)
|
||||||
(~events-frag-booking-item
|
(~fragments/frag-booking-item
|
||||||
:name (get b "name")
|
:name (get b "name")
|
||||||
:date-str (str (format-date (get b "start_at") "%d %b %Y, %H:%M")
|
:date-str (str (format-date (get b "start_at") "%d %b %Y, %H:%M")
|
||||||
(if (get b "end_at")
|
(if (get b "end_at")
|
||||||
@@ -46,5 +46,5 @@
|
|||||||
(span (str "\u00b7 " (get b "calendar_name"))))
|
(span (str "\u00b7 " (get b "calendar_name"))))
|
||||||
:cost-str (when (get b "cost")
|
:cost-str (when (get b "cost")
|
||||||
(span (str "\u00b7 \u00a3" (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))))))))))
|
bookings))))))))))
|
||||||
|
|||||||
@@ -19,13 +19,13 @@
|
|||||||
(post-slug (or (nth slugs i) "")))
|
(post-slug (or (nth slugs i) "")))
|
||||||
(<> (str "<!-- card-widget:" pid " -->")
|
(<> (str "<!-- card-widget:" pid " -->")
|
||||||
(when (not (empty? entries))
|
(when (not (empty? entries))
|
||||||
(~events-frag-entries-widget
|
(~fragments/frag-entries-widget
|
||||||
:cards (<> (map (fn (e)
|
:cards (<> (map (fn (e)
|
||||||
(let ((time-str (str (format-date (get e "start_at") "%H:%M")
|
(let ((time-str (str (format-date (get e "start_at") "%H:%M")
|
||||||
(if (get e "end_at")
|
(if (get e "end_at")
|
||||||
(str " \u2013 " (format-date (get e "end_at") "%H:%M"))
|
(str " \u2013 " (format-date (get e "end_at") "%H:%M"))
|
||||||
""))))
|
""))))
|
||||||
(~events-frag-entry-card
|
(~fragments/frag-entry-card
|
||||||
:href (app-url "events"
|
:href (app-url "events"
|
||||||
(str "/" post-slug
|
(str "/" post-slug
|
||||||
"/" (get e "calendar_slug")
|
"/" (get e "calendar_slug")
|
||||||
|
|||||||
@@ -53,7 +53,7 @@
|
|||||||
(if (get entry "end_at")
|
(if (get entry "end_at")
|
||||||
(str " – " (format-date (get entry "end_at") "%H:%M"))
|
(str " – " (format-date (get entry "end_at") "%H:%M"))
|
||||||
""))))
|
""))))
|
||||||
(~calendar-entry-nav
|
(~shared:navigation/calendar-entry-nav
|
||||||
:href (app-url "events" entry-path)
|
:href (app-url "events" entry-path)
|
||||||
:name (get entry "name")
|
:name (get entry "name")
|
||||||
:date-str date-str
|
:date-str date-str
|
||||||
@@ -61,7 +61,7 @@
|
|||||||
|
|
||||||
;; Infinite scroll sentinel
|
;; Infinite scroll sentinel
|
||||||
(when (and has-more (not (empty? purl)))
|
(when (and has-more (not (empty? purl)))
|
||||||
(~htmx-sentinel
|
(~shared:misc/htmx-sentinel
|
||||||
:id (str "entries-load-sentinel-" pg)
|
:id (str "entries-load-sentinel-" pg)
|
||||||
:hx-get (str purl "?page=" (+ pg 1))
|
:hx-get (str purl "?page=" (+ pg 1))
|
||||||
:hx-trigger "intersect once"
|
:hx-trigger "intersect once"
|
||||||
@@ -74,7 +74,7 @@
|
|||||||
(is-selected (if (not (empty? cur-cal))
|
(is-selected (if (not (empty? cur-cal))
|
||||||
(= (get cal "slug") cur-cal)
|
(= (get cal "slug") cur-cal)
|
||||||
false)))
|
false)))
|
||||||
(~calendar-link-nav
|
(~shared:navigation/calendar-link-nav
|
||||||
:href href
|
:href href
|
||||||
:name (get cal "name")
|
:name (get cal "name")
|
||||||
:nav-class nav-class
|
:nav-class nav-class
|
||||||
|
|||||||
@@ -16,7 +16,7 @@
|
|||||||
:container-type "page"
|
:container-type "page"
|
||||||
:container-id (get post "id")))
|
:container-id (get post "id")))
|
||||||
(cal-names (join ", " (map (fn (c) (get c "name")) calendars))))
|
(cal-names (join ", " (map (fn (c) (get c "name")) calendars))))
|
||||||
(~link-card
|
(~shared:fragments/link-card
|
||||||
:title (get post "title")
|
:title (get post "title")
|
||||||
:image (get post "feature_image")
|
:image (get post "feature_image")
|
||||||
:subtitle cal-names
|
:subtitle cal-names
|
||||||
@@ -28,7 +28,7 @@
|
|||||||
:container-type "page"
|
:container-type "page"
|
||||||
:container-id (get post "id")))
|
:container-id (get post "id")))
|
||||||
(cal-names (join ", " (map (fn (c) (get c "name")) calendars))))
|
(cal-names (join ", " (map (fn (c) (get c "name")) calendars))))
|
||||||
(~link-card
|
(~shared:fragments/link-card
|
||||||
:title (get post "title")
|
:title (get post "title")
|
||||||
:image (get post "feature_image")
|
:image (get post "feature_image")
|
||||||
:subtitle cal-names
|
:subtitle cal-names
|
||||||
|
|||||||
@@ -1,12 +1,12 @@
|
|||||||
;; Events header components
|
;; Events header components
|
||||||
|
|
||||||
(defcomp ~events-calendars-label ()
|
(defcomp ~header/calendars-label ()
|
||||||
(<> (i :class "fa fa-calendar" :aria-hidden "true") (div "Calendars")))
|
(<> (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")))
|
(<> (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-col md:flex-row md:gap-2 items-center min-w-0"
|
||||||
(div :class "flex flex-row items-center gap-2"
|
(div :class "flex flex-row items-center gap-2"
|
||||||
(i :class "fa fa-calendar")
|
(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"
|
:class "text-base font-normal break-words whitespace-normal min-w-0 break-all w-full text-center block"
|
||||||
description)))
|
description)))
|
||||||
|
|
||||||
(defcomp ~events-day-label (&key date-str)
|
(defcomp ~header/day-label (&key date-str)
|
||||||
(div :class "flex gap-1 items-center"
|
(div :class "flex gap-1 items-center"
|
||||||
(i :class "fa fa-calendar-day")
|
(i :class "fa fa-calendar-day")
|
||||||
(span date-str)))
|
(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"
|
(div :id (str "entry-title-" entry-id) :class "flex gap-1 items-center"
|
||||||
title times))
|
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-col md:flex-row md:gap-2 items-center"
|
||||||
(div :class "flex flex-row items-center gap-2"
|
(div :class "flex flex-row items-center gap-2"
|
||||||
(i :class "fa fa-clock")
|
(i :class "fa fa-clock")
|
||||||
|
|||||||
@@ -11,20 +11,20 @@
|
|||||||
(let ((__cal (events-calendar-ctx))
|
(let ((__cal (events-calendar-ctx))
|
||||||
(__sc (select-colours)))
|
(__sc (select-colours)))
|
||||||
(when (get __cal "slug")
|
(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"
|
:link-href (url-for "calendar.get"
|
||||||
:calendar-slug (get __cal "slug"))
|
:calendar-slug (get __cal "slug"))
|
||||||
:link-label-content (~events-calendar-label
|
:link-label-content (~header/calendar-label
|
||||||
:name (get __cal "name")
|
:name (get __cal "name")
|
||||||
:description (get __cal "description"))
|
:description (get __cal "description"))
|
||||||
:nav (<>
|
:nav (<>
|
||||||
(~nav-link :href (url-for "defpage_slots_listing"
|
(~shared:layout/nav-link :href (url-for "defpage_slots_listing"
|
||||||
:calendar-slug (get __cal "slug"))
|
:calendar-slug (get __cal "slug"))
|
||||||
:icon "fa fa-clock" :label "Slots"
|
:icon "fa fa-clock" :label "Slots"
|
||||||
:select-colours __sc)
|
:select-colours __sc)
|
||||||
(let ((__rights (app-rights)))
|
(let ((__rights (app-rights)))
|
||||||
(when (get __rights "admin")
|
(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"))
|
:calendar-slug (get __cal "slug"))
|
||||||
:icon "fa fa-cog"
|
:icon "fa fa-cog"
|
||||||
:select-colours __sc))))
|
:select-colours __sc))))
|
||||||
@@ -37,13 +37,13 @@
|
|||||||
(let ((__cal (events-calendar-ctx))
|
(let ((__cal (events-calendar-ctx))
|
||||||
(__sc (select-colours)))
|
(__sc (select-colours)))
|
||||||
(when (get __cal "slug")
|
(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"
|
:link-label "admin" :icon "fa fa-cog"
|
||||||
:nav (<>
|
:nav (<>
|
||||||
(~nav-link :href (url-for "defpage_slots_listing"
|
(~shared:layout/nav-link :href (url-for "defpage_slots_listing"
|
||||||
:calendar-slug (get __cal "slug"))
|
:calendar-slug (get __cal "slug"))
|
||||||
:label "slots" :select-colours __sc)
|
: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"))
|
:calendar-slug (get __cal "slug"))
|
||||||
:label "description" :select-colours __sc))
|
:label "description" :select-colours __sc))
|
||||||
:child-id "calendar-admin-header-child"
|
:child-id "calendar-admin-header-child"
|
||||||
@@ -55,13 +55,13 @@
|
|||||||
(let ((__day (events-day-ctx))
|
(let ((__day (events-day-ctx))
|
||||||
(__cal (events-calendar-ctx)))
|
(__cal (events-calendar-ctx)))
|
||||||
(when (get __day "date-str")
|
(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"
|
:link-href (url-for "calendar.day.show_day"
|
||||||
:calendar-slug (get __cal "slug")
|
:calendar-slug (get __cal "slug")
|
||||||
:year (get __day "year")
|
:year (get __day "year")
|
||||||
:month (get __day "month")
|
:month (get __day "month")
|
||||||
:day (get __day "day"))
|
:day (get __day "day"))
|
||||||
:link-label-content (~events-day-label
|
:link-label-content (~header/day-label
|
||||||
:date-str (get __day "date-str"))
|
:date-str (get __day "date-str"))
|
||||||
:nav (get __day "nav")
|
:nav (get __day "nav")
|
||||||
:child-id "day-header-child"
|
:child-id "day-header-child"
|
||||||
@@ -73,7 +73,7 @@
|
|||||||
(let ((__day (events-day-ctx))
|
(let ((__day (events-day-ctx))
|
||||||
(__cal (events-calendar-ctx)))
|
(__cal (events-calendar-ctx)))
|
||||||
(when (get __day "date-str")
|
(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"
|
:link-href (url-for "defpage_day_admin"
|
||||||
:calendar-slug (get __cal "slug")
|
:calendar-slug (get __cal "slug")
|
||||||
:year (get __day "year")
|
:year (get __day "year")
|
||||||
@@ -88,12 +88,12 @@
|
|||||||
(quasiquote
|
(quasiquote
|
||||||
(let ((__ectx (events-entry-ctx)))
|
(let ((__ectx (events-entry-ctx)))
|
||||||
(when (get __ectx "id")
|
(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-href (get __ectx "link-href")
|
||||||
:link-label-content (~events-entry-label
|
:link-label-content (~header/entry-label
|
||||||
:entry-id (get __ectx "id")
|
:entry-id (get __ectx "id")
|
||||||
:title (~events-entry-title :name (get __ectx "name"))
|
:title (~admin/entry-title :name (get __ectx "name"))
|
||||||
:times (~events-entry-times :time-str (get __ectx "time-str")))
|
:times (~admin/entry-times :time-str (get __ectx "time-str")))
|
||||||
:nav (get __ectx "nav")
|
:nav (get __ectx "nav")
|
||||||
:child-id "entry-header-child"
|
:child-id "entry-header-child"
|
||||||
:oob (unquote oob))))))
|
:oob (unquote oob))))))
|
||||||
@@ -103,11 +103,11 @@
|
|||||||
(quasiquote
|
(quasiquote
|
||||||
(let ((__ectx (events-entry-ctx)))
|
(let ((__ectx (events-entry-ctx)))
|
||||||
(when (get __ectx "id")
|
(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-href (get __ectx "admin-href")
|
||||||
:link-label "admin" :icon "fa fa-cog"
|
:link-label "admin" :icon "fa fa-cog"
|
||||||
:nav (when (get __ectx "is-admin")
|
: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"
|
:label "ticket_types"
|
||||||
:select-colours (get __ectx "select-colours")))
|
:select-colours (get __ectx "select-colours")))
|
||||||
:child-id "entry-admin-header-child"
|
:child-id "entry-admin-header-child"
|
||||||
@@ -118,8 +118,8 @@
|
|||||||
(quasiquote
|
(quasiquote
|
||||||
(let ((__slot (events-slot-ctx)))
|
(let ((__slot (events-slot-ctx)))
|
||||||
(when (get __slot "name")
|
(when (get __slot "name")
|
||||||
(~menu-row-sx :id "slot-row" :level 5
|
(~shared:layout/menu-row-sx :id "slot-row" :level 5
|
||||||
:link-label-content (~events-slot-label
|
:link-label-content (~header/slot-label
|
||||||
:name (get __slot "name")
|
:name (get __slot "name")
|
||||||
:description (get __slot "description"))
|
:description (get __slot "description"))
|
||||||
:child-id "slot-header-child"
|
:child-id "slot-header-child"
|
||||||
@@ -131,12 +131,12 @@
|
|||||||
(let ((__ectx (events-entry-ctx))
|
(let ((__ectx (events-entry-ctx))
|
||||||
(__cal (events-calendar-ctx)))
|
(__cal (events-calendar-ctx)))
|
||||||
(when (get __ectx "id")
|
(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-href (get __ectx "ticket-types-href")
|
||||||
:link-label-content (<>
|
:link-label-content (<>
|
||||||
(i :class "fa fa-ticket")
|
(i :class "fa fa-ticket")
|
||||||
(div :class "shrink-0" "ticket types"))
|
(div :class "shrink-0" "ticket types"))
|
||||||
:nav (~events-admin-placeholder-nav)
|
:nav (~forms/admin-placeholder-nav)
|
||||||
:child-id "ticket_type-header-child"
|
:child-id "ticket_type-header-child"
|
||||||
:oob (unquote oob))))))
|
:oob (unquote oob))))))
|
||||||
|
|
||||||
@@ -145,22 +145,22 @@
|
|||||||
(quasiquote
|
(quasiquote
|
||||||
(let ((__tt (events-ticket-type-ctx)))
|
(let ((__tt (events-ticket-type-ctx)))
|
||||||
(when (get __tt "id")
|
(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-href (get __tt "link-href")
|
||||||
:link-label-content (div :class "flex flex-col md:flex-row md:gap-2 items-center"
|
: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"
|
(div :class "flex flex-row items-center gap-2"
|
||||||
(i :class "fa fa-ticket")
|
(i :class "fa fa-ticket")
|
||||||
(div :class "shrink-0" (get __tt "name"))))
|
(div :class "shrink-0" (get __tt "name"))))
|
||||||
:nav (~events-admin-placeholder-nav)
|
:nav (~forms/admin-placeholder-nav)
|
||||||
:child-id "ticket_type-header-child-inner"
|
:child-id "ticket_type-header-child-inner"
|
||||||
:oob (unquote oob))))))
|
:oob (unquote oob))))))
|
||||||
|
|
||||||
(defmacro ~events-markets-header-auto (oob)
|
(defmacro ~events-markets-header-auto (oob)
|
||||||
"Markets section header row."
|
"Markets section header row."
|
||||||
(quasiquote
|
(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-href (url-for "defpage_events_markets")
|
||||||
:link-label-content (~events-markets-label)
|
:link-label-content (~header/markets-label)
|
||||||
:child-id "markets-header-child"
|
:child-id "markets-header-child"
|
||||||
:oob (unquote oob))))
|
:oob (unquote oob))))
|
||||||
|
|
||||||
@@ -168,218 +168,218 @@
|
|||||||
;; OOB clear helpers — clear deeper header rows not present at this level
|
;; 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 divs for cal-admin level (keeps down to calendar-admin)."
|
||||||
(<>
|
(<>
|
||||||
(~clear-oob-div :id "entry-admin-row")
|
(~shared:layout/clear-oob-div :id "entry-admin-row")
|
||||||
(~clear-oob-div :id "entry-admin-header-child")
|
(~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||||
(~clear-oob-div :id "entry-row")
|
(~shared:layout/clear-oob-div :id "entry-row")
|
||||||
(~clear-oob-div :id "entry-header-child")
|
(~shared:layout/clear-oob-div :id "entry-header-child")
|
||||||
(~clear-oob-div :id "day-admin-row")
|
(~shared:layout/clear-oob-div :id "day-admin-row")
|
||||||
(~clear-oob-div :id "day-admin-header-child")
|
(~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||||
(~clear-oob-div :id "day-row")
|
(~shared:layout/clear-oob-div :id "day-row")
|
||||||
(~clear-oob-div :id "day-header-child")
|
(~shared:layout/clear-oob-div :id "day-header-child")
|
||||||
(~clear-oob-div :id "calendars-row")
|
(~shared:layout/clear-oob-div :id "calendars-row")
|
||||||
(~clear-oob-div :id "calendars-header-child")))
|
(~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 divs for slot level."
|
||||||
(<>
|
(<>
|
||||||
(~clear-oob-div :id "entry-admin-row")
|
(~shared:layout/clear-oob-div :id "entry-admin-row")
|
||||||
(~clear-oob-div :id "entry-admin-header-child")
|
(~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||||
(~clear-oob-div :id "entry-row")
|
(~shared:layout/clear-oob-div :id "entry-row")
|
||||||
(~clear-oob-div :id "entry-header-child")
|
(~shared:layout/clear-oob-div :id "entry-header-child")
|
||||||
(~clear-oob-div :id "day-admin-row")
|
(~shared:layout/clear-oob-div :id "day-admin-row")
|
||||||
(~clear-oob-div :id "day-admin-header-child")
|
(~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||||
(~clear-oob-div :id "day-row")
|
(~shared:layout/clear-oob-div :id "day-row")
|
||||||
(~clear-oob-div :id "day-header-child")
|
(~shared:layout/clear-oob-div :id "day-header-child")
|
||||||
(~clear-oob-div :id "calendars-row")
|
(~shared:layout/clear-oob-div :id "calendars-row")
|
||||||
(~clear-oob-div :id "calendars-header-child")))
|
(~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 divs for day-admin level."
|
||||||
(<>
|
(<>
|
||||||
(~clear-oob-div :id "entry-admin-row")
|
(~shared:layout/clear-oob-div :id "entry-admin-row")
|
||||||
(~clear-oob-div :id "entry-admin-header-child")
|
(~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||||
(~clear-oob-div :id "entry-row")
|
(~shared:layout/clear-oob-div :id "entry-row")
|
||||||
(~clear-oob-div :id "entry-header-child")
|
(~shared:layout/clear-oob-div :id "entry-header-child")
|
||||||
(~clear-oob-div :id "calendars-row")
|
(~shared:layout/clear-oob-div :id "calendars-row")
|
||||||
(~clear-oob-div :id "calendars-header-child")))
|
(~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 divs for entry level (public, no admin rows)."
|
||||||
(<>
|
(<>
|
||||||
(~clear-oob-div :id "entry-admin-row")
|
(~shared:layout/clear-oob-div :id "entry-admin-row")
|
||||||
(~clear-oob-div :id "entry-admin-header-child")
|
(~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||||
(~clear-oob-div :id "day-admin-row")
|
(~shared:layout/clear-oob-div :id "day-admin-row")
|
||||||
(~clear-oob-div :id "day-admin-header-child")
|
(~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||||
(~clear-oob-div :id "calendar-admin-row")
|
(~shared:layout/clear-oob-div :id "calendar-admin-row")
|
||||||
(~clear-oob-div :id "calendar-admin-header-child")
|
(~shared:layout/clear-oob-div :id "calendar-admin-header-child")
|
||||||
(~clear-oob-div :id "calendars-row")
|
(~shared:layout/clear-oob-div :id "calendars-row")
|
||||||
(~clear-oob-div :id "calendars-header-child")
|
(~shared:layout/clear-oob-div :id "calendars-header-child")
|
||||||
(~clear-oob-div :id "post-admin-row")
|
(~shared:layout/clear-oob-div :id "post-admin-row")
|
||||||
(~clear-oob-div :id "post-admin-header-child")))
|
(~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 divs for entry-admin level."
|
||||||
(<>
|
(<>
|
||||||
(~clear-oob-div :id "calendars-row")
|
(~shared:layout/clear-oob-div :id "calendars-row")
|
||||||
(~clear-oob-div :id "calendars-header-child")))
|
(~shared:layout/clear-oob-div :id "calendars-header-child")))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; OOB clear helpers for renders.py — clear all deeper IDs except kept ones
|
;; 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 all events IDs deeper than post level."
|
||||||
(<>
|
(<>
|
||||||
(~clear-oob-div :id "entry-admin-row") (~clear-oob-div :id "entry-admin-header-child")
|
(~shared:layout/clear-oob-div :id "entry-admin-row") (~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||||
(~clear-oob-div :id "entry-row") (~clear-oob-div :id "entry-header-child")
|
(~shared:layout/clear-oob-div :id "entry-row") (~shared:layout/clear-oob-div :id "entry-header-child")
|
||||||
(~clear-oob-div :id "day-admin-row") (~clear-oob-div :id "day-admin-header-child")
|
(~shared:layout/clear-oob-div :id "day-admin-row") (~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||||
(~clear-oob-div :id "day-row") (~clear-oob-div :id "day-header-child")
|
(~shared:layout/clear-oob-div :id "day-row") (~shared:layout/clear-oob-div :id "day-header-child")
|
||||||
(~clear-oob-div :id "calendar-admin-row") (~clear-oob-div :id "calendar-admin-header-child")
|
(~shared:layout/clear-oob-div :id "calendar-admin-row") (~shared:layout/clear-oob-div :id "calendar-admin-header-child")
|
||||||
(~clear-oob-div :id "calendar-row") (~clear-oob-div :id "calendar-header-child")
|
(~shared:layout/clear-oob-div :id "calendar-row") (~shared:layout/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 "calendars-row") (~shared:layout/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 "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 all events IDs deeper than post-admin level."
|
||||||
(<>
|
(<>
|
||||||
(~clear-oob-div :id "entry-admin-row") (~clear-oob-div :id "entry-admin-header-child")
|
(~shared:layout/clear-oob-div :id "entry-admin-row") (~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||||
(~clear-oob-div :id "entry-row") (~clear-oob-div :id "entry-header-child")
|
(~shared:layout/clear-oob-div :id "entry-row") (~shared:layout/clear-oob-div :id "entry-header-child")
|
||||||
(~clear-oob-div :id "day-admin-row") (~clear-oob-div :id "day-admin-header-child")
|
(~shared:layout/clear-oob-div :id "day-admin-row") (~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||||
(~clear-oob-div :id "day-row") (~clear-oob-div :id "day-header-child")
|
(~shared:layout/clear-oob-div :id "day-row") (~shared:layout/clear-oob-div :id "day-header-child")
|
||||||
(~clear-oob-div :id "calendar-admin-row") (~clear-oob-div :id "calendar-admin-header-child")
|
(~shared:layout/clear-oob-div :id "calendar-admin-row") (~shared:layout/clear-oob-div :id "calendar-admin-header-child")
|
||||||
(~clear-oob-div :id "calendar-row") (~clear-oob-div :id "calendar-header-child")
|
(~shared:layout/clear-oob-div :id "calendar-row") (~shared:layout/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 "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 all events IDs deeper than calendar level."
|
||||||
(<>
|
(<>
|
||||||
(~clear-oob-div :id "entry-admin-row") (~clear-oob-div :id "entry-admin-header-child")
|
(~shared:layout/clear-oob-div :id "entry-admin-row") (~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||||
(~clear-oob-div :id "entry-row") (~clear-oob-div :id "entry-header-child")
|
(~shared:layout/clear-oob-div :id "entry-row") (~shared:layout/clear-oob-div :id "entry-header-child")
|
||||||
(~clear-oob-div :id "day-admin-row") (~clear-oob-div :id "day-admin-header-child")
|
(~shared:layout/clear-oob-div :id "day-admin-row") (~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||||
(~clear-oob-div :id "day-row") (~clear-oob-div :id "day-header-child")
|
(~shared:layout/clear-oob-div :id "day-row") (~shared:layout/clear-oob-div :id "day-header-child")
|
||||||
(~clear-oob-div :id "calendar-admin-row") (~clear-oob-div :id "calendar-admin-header-child")
|
(~shared:layout/clear-oob-div :id "calendar-admin-row") (~shared:layout/clear-oob-div :id "calendar-admin-header-child")
|
||||||
(~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")
|
||||||
(~clear-oob-div :id "post-admin-row") (~clear-oob-div :id "post-admin-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 all events IDs deeper than day level."
|
||||||
(<>
|
(<>
|
||||||
(~clear-oob-div :id "entry-admin-row") (~clear-oob-div :id "entry-admin-header-child")
|
(~shared:layout/clear-oob-div :id "entry-admin-row") (~shared:layout/clear-oob-div :id "entry-admin-header-child")
|
||||||
(~clear-oob-div :id "entry-row") (~clear-oob-div :id "entry-header-child")
|
(~shared:layout/clear-oob-div :id "entry-row") (~shared:layout/clear-oob-div :id "entry-header-child")
|
||||||
(~clear-oob-div :id "day-admin-row") (~clear-oob-div :id "day-admin-header-child")
|
(~shared:layout/clear-oob-div :id "day-admin-row") (~shared:layout/clear-oob-div :id "day-admin-header-child")
|
||||||
(~clear-oob-div :id "calendar-admin-row") (~clear-oob-div :id "calendar-admin-header-child")
|
(~shared:layout/clear-oob-div :id "calendar-admin-row") (~shared:layout/clear-oob-div :id "calendar-admin-header-child")
|
||||||
(~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")
|
||||||
(~clear-oob-div :id "post-admin-row") (~clear-oob-div :id "post-admin-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)
|
;; 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)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (<> (~post-header-auto nil)
|
:inner (<> (~post-header-auto nil)
|
||||||
(~post-admin-header-auto nil "calendars")
|
(~post-admin-header-auto nil "calendars")
|
||||||
(~events-calendar-header-auto nil)
|
(~events-calendar-header-auto nil)
|
||||||
(~events-calendar-admin-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")
|
(<> (~post-admin-header-auto true "calendars")
|
||||||
(~events-calendar-header-auto true)
|
(~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))
|
:row (~events-calendar-admin-header-auto nil))
|
||||||
(~events-clear-oob-cal-admin)
|
(~layouts/clear-oob-cal-admin)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Slots layout: same full as cal-admin
|
;; Slots layout: same full as cal-admin
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~events-slots-layout-full ()
|
(defcomp ~layouts/slots-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (<> (~post-header-auto nil)
|
:inner (<> (~post-header-auto nil)
|
||||||
(~post-admin-header-auto nil "calendars")
|
(~post-admin-header-auto nil "calendars")
|
||||||
(~events-calendar-header-auto nil)
|
(~events-calendar-header-auto nil)
|
||||||
(~events-calendar-admin-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")
|
(<> (~post-admin-header-auto true "calendars")
|
||||||
(~events-calendar-admin-header-auto true)
|
(~events-calendar-admin-header-auto true)
|
||||||
(~events-clear-oob-cal-admin)
|
(~layouts/clear-oob-cal-admin)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Slot detail layout: root + post + child(admin + cal + cal-admin + slot)
|
;; Slot detail layout: root + post + child(admin + cal + cal-admin + slot)
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~events-slot-layout-full ()
|
(defcomp ~layouts/slot-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (<> (~post-header-auto nil)
|
:inner (<> (~post-header-auto nil)
|
||||||
(~post-admin-header-auto nil "calendars")
|
(~post-admin-header-auto nil "calendars")
|
||||||
(~events-calendar-header-auto nil)
|
(~events-calendar-header-auto nil)
|
||||||
(~events-calendar-admin-header-auto nil)
|
(~events-calendar-admin-header-auto nil)
|
||||||
(~events-slot-header-auto nil)))))
|
(~events-slot-header-auto nil)))))
|
||||||
|
|
||||||
(defcomp ~events-slot-layout-oob ()
|
(defcomp ~layouts/slot-layout-oob ()
|
||||||
(<> (~post-admin-header-auto true "calendars")
|
(<> (~post-admin-header-auto true "calendars")
|
||||||
(~events-calendar-admin-header-auto true)
|
(~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))
|
:row (~events-slot-header-auto nil))
|
||||||
(~events-clear-oob-slot)
|
(~layouts/clear-oob-slot)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Day admin layout: root + post + child(admin + cal + day + day-admin)
|
;; 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)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (<> (~post-header-auto nil)
|
:inner (<> (~post-header-auto nil)
|
||||||
(~post-admin-header-auto nil "calendars")
|
(~post-admin-header-auto nil "calendars")
|
||||||
(~events-calendar-header-auto nil)
|
(~events-calendar-header-auto nil)
|
||||||
(~events-day-header-auto nil)
|
(~events-day-header-auto nil)
|
||||||
(~events-day-admin-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")
|
(<> (~post-admin-header-auto true "calendars")
|
||||||
(~events-calendar-header-auto true)
|
(~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))
|
:row (~events-day-admin-header-auto nil))
|
||||||
(~events-clear-oob-day-admin)
|
(~layouts/clear-oob-day-admin)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Entry layout: root + child(post + cal + day + entry) — public, no admin
|
;; Entry layout: root + child(post + cal + day + entry) — public, no admin
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~events-entry-layout-full ()
|
(defcomp ~layouts/entry-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (<> (~post-header-auto nil)
|
:inner (<> (~post-header-auto nil)
|
||||||
(~events-calendar-header-auto nil)
|
(~events-calendar-header-auto nil)
|
||||||
(~events-day-header-auto nil)
|
(~events-day-header-auto nil)
|
||||||
(~events-entry-header-auto nil)))))
|
(~events-entry-header-auto nil)))))
|
||||||
|
|
||||||
(defcomp ~events-entry-layout-oob ()
|
(defcomp ~layouts/entry-layout-oob ()
|
||||||
(<> (~events-day-header-auto true)
|
(<> (~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))
|
:row (~events-entry-header-auto nil))
|
||||||
(~events-clear-oob-entry)
|
(~layouts/clear-oob-entry)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Entry admin layout: root + post + child(admin + cal + day + entry + entry-admin)
|
;; 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)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (<> (~post-header-auto nil)
|
:inner (<> (~post-header-auto nil)
|
||||||
(~post-admin-header-auto nil "calendars")
|
(~post-admin-header-auto nil "calendars")
|
||||||
(~events-calendar-header-auto nil)
|
(~events-calendar-header-auto nil)
|
||||||
@@ -387,21 +387,21 @@
|
|||||||
(~events-entry-header-auto nil)
|
(~events-entry-header-auto nil)
|
||||||
(~events-entry-admin-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")
|
(<> (~post-admin-header-auto true "calendars")
|
||||||
(~events-entry-header-auto true)
|
(~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))
|
:row (~events-entry-admin-header-auto nil))
|
||||||
(~events-clear-oob-entry-admin)
|
(~layouts/clear-oob-entry-admin)
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Ticket types layout: root + child(post + cal + day + entry + entry-admin + ticket-types)
|
;; 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)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (<> (~post-header-auto nil)
|
:inner (<> (~post-header-auto nil)
|
||||||
(~events-calendar-header-auto nil)
|
(~events-calendar-header-auto nil)
|
||||||
(~events-day-header-auto nil)
|
(~events-day-header-auto nil)
|
||||||
@@ -409,9 +409,9 @@
|
|||||||
(~events-entry-admin-header-auto nil)
|
(~events-entry-admin-header-auto nil)
|
||||||
(~events-ticket-types-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)
|
(<> (~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))
|
:row (~events-ticket-types-header-auto nil))
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
@@ -419,9 +419,9 @@
|
|||||||
;; Ticket type layout: all headers down to ticket-type
|
;; Ticket type layout: all headers down to ticket-type
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~events-ticket-type-layout-full ()
|
(defcomp ~layouts/ticket-type-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (<> (~post-header-auto nil)
|
:inner (<> (~post-header-auto nil)
|
||||||
(~events-calendar-header-auto nil)
|
(~events-calendar-header-auto nil)
|
||||||
(~events-day-header-auto nil)
|
(~events-day-header-auto nil)
|
||||||
@@ -430,9 +430,9 @@
|
|||||||
(~events-ticket-types-header-auto nil)
|
(~events-ticket-types-header-auto nil)
|
||||||
(~events-ticket-type-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)
|
(<> (~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))
|
:row (~events-ticket-type-header-auto nil))
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|
||||||
@@ -440,14 +440,14 @@
|
|||||||
;; Markets layout: root + child(post + markets)
|
;; Markets layout: root + child(post + markets)
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~events-markets-layout-full ()
|
(defcomp ~layouts/markets-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (<> (~post-header-auto nil)
|
:inner (<> (~post-header-auto nil)
|
||||||
(~events-markets-header-auto nil)))))
|
(~events-markets-header-auto nil)))))
|
||||||
|
|
||||||
(defcomp ~events-markets-layout-oob ()
|
(defcomp ~layouts/markets-layout-oob ()
|
||||||
(<> (~post-header-auto true)
|
(<> (~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))
|
:row (~events-markets-header-auto nil))
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|||||||
@@ -1,15 +1,15 @@
|
|||||||
;; Events page-level components (slots, ticket types, buy form, cart, posts nav)
|
;; 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))
|
(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))
|
(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"))
|
(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
|
(section :id (str "slot-" slot-id) :class list-container
|
||||||
(div :class "flex flex-col"
|
(div :class "flex flex-col"
|
||||||
(div :class "text-xs font-semibold uppercase tracking-wide text-stone-500" "Days")
|
(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
|
(button :type "button" :class pre-action :sx-get edit-url
|
||||||
:sx-target (str "#slot-" slot-id) :sx-swap "outerHTML" "Edit")))
|
: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"
|
(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"
|
:class "text-base font-normal break-words whitespace-normal min-w-0 break-all w-full text-center block"
|
||||||
description))
|
description))
|
||||||
|
|
||||||
(defcomp ~events-slots-empty-row ()
|
(defcomp ~page/slots-empty-row ()
|
||||||
(tr (td :colspan "5" :class "p-3 text-stone-500" "No slots yet.")))
|
(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)
|
flexible days time-str cost-str action-btn del-url csrf-hdr)
|
||||||
(tr :class tr-cls
|
(tr :class tr-cls
|
||||||
(td :class "p-2 align-top w-1/6"
|
(td :class "p-2 align-top w-1/6"
|
||||||
@@ -57,7 +57,7 @@
|
|||||||
:sx-swap "outerHTML" :sx-headers csrf-hdr :sx-trigger "confirmed"
|
:sx-swap "outerHTML" :sx-headers csrf-hdr :sx-trigger "confirmed"
|
||||||
(i :class "fa-solid fa-trash")))))
|
(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
|
(section :id "slots-table" :class list-container
|
||||||
(table :class "w-full text-sm border table-fixed"
|
(table :class "w-full text-sm border table-fixed"
|
||||||
(thead :class "bg-stone-100"
|
(thead :class "bg-stone-100"
|
||||||
@@ -78,61 +78,61 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
;; Days pills from data — replaces Python loop
|
;; 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)))
|
(if (empty? (or days (list)))
|
||||||
(~events-slot-no-days)
|
(~page/slot-no-days)
|
||||||
(~events-slot-days-pills
|
(~page/slot-days-pills
|
||||||
:days-inner (<> (map (lambda (d) (~events-slot-day-pill :day d)) days)))))
|
:days-inner (<> (map (lambda (d) (~page/slot-day-pill :day d)) days)))))
|
||||||
|
|
||||||
;; Slot panel from data
|
;; 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
|
flexible time-str cost-str
|
||||||
pre-action edit-url description oob)
|
pre-action edit-url description oob)
|
||||||
(<>
|
(<>
|
||||||
(~events-slot-panel
|
(~page/slot-panel
|
||||||
:slot-id slot-id :list-container list-container
|
: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
|
:flexible flexible :time-str time-str :cost-str cost-str
|
||||||
:pre-action pre-action :edit-url edit-url)
|
:pre-action pre-action :edit-url edit-url)
|
||||||
(when oob
|
(when oob
|
||||||
(~events-slot-description-oob :description (or description "")))))
|
(~page/slot-description-oob :description (or description "")))))
|
||||||
|
|
||||||
;; Slots table from data
|
;; 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)
|
tr-cls pill-cls action-btn hx-select csrf-hdr)
|
||||||
(~events-slots-table
|
(~page/slots-table
|
||||||
:list-container list-container
|
:list-container list-container
|
||||||
:rows (if (empty? (or slots (list)))
|
:rows (if (empty? (or slots (list)))
|
||||||
(~events-slots-empty-row)
|
(~page/slots-empty-row)
|
||||||
(<> (map (lambda (s)
|
(<> (map (lambda (s)
|
||||||
(~events-slots-row
|
(~page/slots-row
|
||||||
:tr-cls tr-cls :slot-href (get s "slot-href")
|
:tr-cls tr-cls :slot-href (get s "slot-href")
|
||||||
:pill-cls pill-cls :hx-select hx-select
|
:pill-cls pill-cls :hx-select hx-select
|
||||||
:slot-name (get s "slot-name") :description (get s "description")
|
:slot-name (get s "slot-name") :description (get s "description")
|
||||||
:flexible (get s "flexible")
|
: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")
|
:time-str (get s "time-str")
|
||||||
:cost-str (get s "cost-str") :action-btn action-btn
|
:cost-str (get s "cost-str") :action-btn action-btn
|
||||||
:del-url (get s "del-url") :csrf-hdr csrf-hdr))
|
:del-url (get s "del-url") :csrf-hdr csrf-hdr))
|
||||||
(or slots (list)))))
|
(or slots (list)))))
|
||||||
:pre-action pre-action :add-url add-url))
|
: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 "flex flex-col"
|
||||||
(div :class "text-xs font-semibold uppercase tracking-wide text-stone-500" label)
|
(div :class "text-xs font-semibold uppercase tracking-wide text-stone-500" label)
|
||||||
(div :class "mt-1" value)))
|
(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
|
(section :id (str "ticket-" ticket-id) :class list-container
|
||||||
(div :class "grid grid-cols-1 sm:grid-cols-3 gap-4 text-sm"
|
(div :class "grid grid-cols-1 sm:grid-cols-3 gap-4 text-sm"
|
||||||
c1 c2 c3)
|
c1 c2 c3)
|
||||||
(button :type "button" :class pre-action :sx-get edit-url
|
(button :type "button" :class pre-action :sx-get edit-url
|
||||||
:sx-target (str "#ticket-" ticket-id) :sx-swap "outerHTML" "Edit")))
|
: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.")))
|
(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)
|
action-btn del-url csrf-hdr)
|
||||||
(tr :class tr-cls
|
(tr :class tr-cls
|
||||||
(td :class "p-2 align-top w-1/3"
|
(td :class "p-2 align-top w-1/3"
|
||||||
@@ -151,7 +151,7 @@
|
|||||||
:sx-swap "outerHTML" :sx-headers csrf-hdr :sx-trigger "confirmed"
|
:sx-swap "outerHTML" :sx-headers csrf-hdr :sx-trigger "confirmed"
|
||||||
(i :class "fa-solid fa-trash")))))
|
(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
|
(section :id "tickets-table" :class list-container
|
||||||
(table :class "w-full text-sm border table-fixed"
|
(table :class "w-full text-sm border table-fixed"
|
||||||
(thead :class "bg-stone-100"
|
(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"
|
(button :class action-btn :sx-get add-url :sx-target "#ticket-add-container" :sx-swap "innerHTML"
|
||||||
(i :class "fa fa-plus") " Add ticket type"))))
|
(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 "space-y-2"
|
||||||
(div :class "flex items-center gap-2"
|
(div :class "flex items-center gap-2"
|
||||||
(span :class "text-sm font-medium text-stone-700" "Price:")
|
(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"
|
(button :type "button" :class "text-xs text-blue-600 hover:text-blue-800 underline"
|
||||||
:onclick show-js "Edit ticket config")))
|
: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"
|
(div :class "space-y-2"
|
||||||
(span :class "text-sm text-stone-400" "No tickets configured")
|
(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"
|
(button :type "button" :class "block text-xs text-blue-600 hover:text-blue-800 underline"
|
||||||
:onclick show-js "Configure tickets")))
|
: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")
|
(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"
|
:sx-post update-url :sx-target (str "#entry-tickets-" entry-id) :sx-swap "innerHTML"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||||
@@ -203,12 +203,12 @@
|
|||||||
:onclick hide-js "Cancel"))))
|
:onclick hide-js "Cancel"))))
|
||||||
|
|
||||||
;; Data-driven buy form — Python passes pre-resolved data, .sx does layout + iteration
|
;; 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
|
ticket-types user-ticket-counts-by-type
|
||||||
user-ticket-count price-str adjust-url csrf state
|
user-ticket-count price-str adjust-url csrf state
|
||||||
my-tickets-href)
|
my-tickets-href)
|
||||||
(if (!= state "confirmed")
|
(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))
|
(let ((eid-s (str entry-id))
|
||||||
(target (str "#ticket-buy-" 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"
|
(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 :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 (div :class "font-medium text-sm" (get tt "name"))
|
||||||
(div :class "text-xs text-stone-500" (get tt "cost_str")))
|
(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
|
:entry-id eid-s :count tt-count :ticket-type-id tt-id
|
||||||
:my-tickets-href my-tickets-href))))
|
:my-tickets-href my-tickets-href))))
|
||||||
ticket-types))
|
ticket-types))
|
||||||
(<> (div :class "flex items-center justify-between mb-4"
|
(<> (div :class "flex items-center justify-between mb-4"
|
||||||
(div (span :class "font-medium text-green-600" price-str)
|
(div (span :class "font-medium text-green-600" price-str)
|
||||||
(span :class "text-sm text-stone-500 ml-2" "per ticket")))
|
(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)
|
:entry-id eid-s :count (if user-ticket-count user-ticket-count 0)
|
||||||
:ticket-type-id nil :my-tickets-href my-tickets-href)))))))
|
:ticket-type-id nil :my-tickets-href my-tickets-href)))))))
|
||||||
|
|
||||||
;; Inline +/- controls (used by both default and per-type)
|
;; 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)
|
(if (= count 0)
|
||||||
(form :sx-post adjust-url :sx-target target :sx-swap "outerHTML" :class "flex items-center"
|
(form :sx-post adjust-url :sx-target target :sx-swap "outerHTML" :class "flex items-center"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(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"
|
: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"
|
(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")
|
(i :class "fa fa-ticket mr-1" :aria-hidden "true")
|
||||||
"Tickets available once this event is confirmed."))
|
"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))
|
(let ((count (len tickets))
|
||||||
(suffix (if (= count 1) "" "s")))
|
(suffix (if (= count 1) "" "s")))
|
||||||
(div :id (str "ticket-buy-" entry-id) :class "rounded-xl border border-emerald-200 bg-emerald-50 p-4"
|
(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")))))
|
"View all my tickets")))))
|
||||||
|
|
||||||
;; Single response wrappers for POST routes (include OOB cart icon)
|
;; 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)
|
cart-count blog-href cart-href logo)
|
||||||
(<>
|
(<>
|
||||||
(~events-cart-icon :cart-count cart-count :blog-href blog-href :cart-href cart-href :logo logo)
|
(~page/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/buy-result :entry-id entry-id :tickets tickets :remaining remaining
|
||||||
:my-tickets-href my-tickets-href)))
|
: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
|
entry-id info-sold info-remaining info-basket
|
||||||
ticket-types user-ticket-counts-by-type
|
ticket-types user-ticket-counts-by-type
|
||||||
user-ticket-count price-str adjust-url csrf state
|
user-ticket-count price-str adjust-url csrf state
|
||||||
my-tickets-href)
|
my-tickets-href)
|
||||||
(<>
|
(<>
|
||||||
(~events-cart-icon :cart-count cart-count :blog-href blog-href :cart-href cart-href :logo logo)
|
(~page/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/buy-form :entry-id entry-id :info-sold info-sold :info-remaining info-remaining
|
||||||
:info-basket info-basket :ticket-types ticket-types
|
:info-basket info-basket :ticket-types ticket-types
|
||||||
:user-ticket-counts-by-type user-ticket-counts-by-type
|
:user-ticket-counts-by-type user-ticket-counts-by-type
|
||||||
:user-ticket-count user-ticket-count :price-str price-str
|
:user-ticket-count user-ticket-count :price-str price-str
|
||||||
@@ -330,18 +330,18 @@
|
|||||||
:my-tickets-href my-tickets-href)))
|
:my-tickets-href my-tickets-href)))
|
||||||
|
|
||||||
;; Unified OOB cart icon — picks logo or badge based on count
|
;; 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)
|
(if (= cart-count 0)
|
||||||
(~events-cart-icon-logo :blog-href blog-href :logo logo)
|
(~page/cart-icon-logo :blog-href blog-href :logo logo)
|
||||||
(~events-cart-icon-badge :cart-href cart-href :count (str cart-count))))
|
(~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 :id "cart-mini" :sx-swap-oob "true"
|
||||||
(div :class "h-12 w-12 rounded-full overflow-hidden border border-stone-300 flex-shrink-0"
|
(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"
|
(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")))))
|
(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"
|
(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"
|
(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")
|
(i :class "fa fa-shopping-cart text-5xl" :aria-hidden "true")
|
||||||
@@ -349,37 +349,37 @@
|
|||||||
count))))
|
count))))
|
||||||
|
|
||||||
;; Inline ticket widget (for all-events/page-summary cards)
|
;; 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"
|
(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 "csrf_token" :value csrf)
|
||||||
(input :type "hidden" :name "entry_id" :value entry-id)
|
(input :type "hidden" :name "entry_id" :value entry-id)
|
||||||
(input :type "hidden" :name "count" :value count-val)
|
(input :type "hidden" :name "count" :value count-val)
|
||||||
btn))
|
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"
|
(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")))
|
(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" "-"))
|
(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" "+"))
|
(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 text-emerald-700"
|
||||||
(span :class "relative inline-flex items-center justify-center"
|
(span :class "relative inline-flex items-center justify-center"
|
||||||
(i :class "fa-solid fa-shopping-cart text-xl" :aria-hidden "true")
|
(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 "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)))))
|
(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"
|
(div :id (str "page-ticket-" entry-id) :class "flex items-center gap-2"
|
||||||
(span :class "text-green-600 font-medium text-sm" price)
|
(span :class "text-green-600 font-medium text-sm" price)
|
||||||
inner))
|
inner))
|
||||||
|
|
||||||
;; Entry posts panel
|
;; 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"
|
(div :class "space-y-2"
|
||||||
posts
|
posts
|
||||||
(div :class "mt-3 pt-3 border-t"
|
(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")
|
: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"))))
|
(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))
|
(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"))
|
(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"
|
(div :class "flex items-center justify-between gap-3 p-2 bg-stone-50 rounded border"
|
||||||
img (span :class "text-sm flex-1" title)
|
img (span :class "text-sm flex-1" title)
|
||||||
(button :type "button" :class "text-xs text-red-600 hover:text-red-800 flex-shrink-0"
|
(button :type "button" :class "text-xs text-red-600 hover:text-red-800 flex-shrink-0"
|
||||||
@@ -409,41 +409,41 @@
|
|||||||
:sx-headers csrf-hdr
|
:sx-headers csrf-hdr
|
||||||
(i :class "fa fa-times") " Remove")))
|
(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"))
|
(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"))
|
(div :class "w-8 h-8 rounded-full bg-stone-200 flex-shrink-0"))
|
||||||
|
|
||||||
;; Entry posts nav OOB
|
;; 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"))
|
(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"
|
(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"
|
:id "entry-posts-nav-wrapper" :sx-swap-oob "true"
|
||||||
(div :class "flex overflow-x-auto gap-1 scrollbar-thin" items)))
|
(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))))
|
(a :href href :class nav-btn img (div :class "flex-1 min-w-0" (div :class "font-medium truncate" title))))
|
||||||
|
|
||||||
;; Post nav entries OOB
|
;; 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"))
|
(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
|
(a :href href :class nav-btn
|
||||||
(div :class "w-8 h-8 rounded bg-stone-200 flex-shrink-0")
|
(div :class "w-8 h-8 rounded bg-stone-200 flex-shrink-0")
|
||||||
(div :class "flex-1 min-w-0"
|
(div :class "flex-1 min-w-0"
|
||||||
(div :class "font-medium truncate" name)
|
(div :class "font-medium truncate" name)
|
||||||
(div :class "text-xs text-stone-600 truncate" time-str))))
|
(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
|
(a :href href :class nav-btn
|
||||||
(i :class "fa fa-calendar" :aria-hidden "true")
|
(i :class "fa fa-calendar" :aria-hidden "true")
|
||||||
(div name)))
|
(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"
|
(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"
|
: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"
|
(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"))))
|
(i :class "fa fa-chevron-right"))))
|
||||||
|
|
||||||
;; Entry nav post link (with image)
|
;; 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"
|
(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))))
|
img (div :class "flex-1 min-w-0" (div :class "font-medium truncate" title))))
|
||||||
|
|
||||||
@@ -471,60 +471,60 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
;; Post image helper from data
|
;; 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
|
(if src
|
||||||
(~events-post-img :src src :alt alt)
|
(~page/post-img :src src :alt alt)
|
||||||
(~events-post-img-placeholder)))
|
(~page/post-img-placeholder)))
|
||||||
|
|
||||||
;; Entry posts nav OOB from data
|
;; 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)))
|
(if (empty? (or posts (list)))
|
||||||
(~events-entry-posts-nav-oob-empty)
|
(~page/entry-posts-nav-oob-empty)
|
||||||
(~events-entry-posts-nav-oob
|
(~page/entry-posts-nav-oob
|
||||||
:items (<> (map (lambda (p)
|
:items (<> (map (lambda (p)
|
||||||
(~events-entry-nav-post
|
(~page/entry-nav-post
|
||||||
:href (get p "href") :nav-btn nav-btn
|
: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")))
|
:title (get p "title")))
|
||||||
posts)))))
|
posts)))))
|
||||||
|
|
||||||
;; Entry posts nav (non-OOB) from data — for desktop nav embedding
|
;; 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))))
|
(when (not (empty? (or posts (list))))
|
||||||
(~events-entry-posts-nav-oob
|
(~page/entry-posts-nav-oob
|
||||||
:items (<> (map (lambda (p)
|
:items (<> (map (lambda (p)
|
||||||
(~events-entry-nav-post-link
|
(~page/entry-nav-post-link
|
||||||
:href (get p "href")
|
: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")))
|
:title (get p "title")))
|
||||||
posts)))))
|
posts)))))
|
||||||
|
|
||||||
;; Post nav entries+calendars OOB from data
|
;; 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))))
|
(if (and (empty? (or entries (list))) (empty? (or calendars (list))))
|
||||||
(~events-post-nav-oob-empty)
|
(~page/post-nav-oob-empty)
|
||||||
(~events-post-nav-wrapper
|
(~page/post-nav-wrapper
|
||||||
:items (<>
|
:items (<>
|
||||||
(map (lambda (e)
|
(map (lambda (e)
|
||||||
(~events-post-nav-entry
|
(~page/post-nav-entry
|
||||||
:href (get e "href") :nav-btn nav-btn
|
:href (get e "href") :nav-btn nav-btn
|
||||||
:name (get e "name") :time-str (get e "time-str")))
|
:name (get e "name") :time-str (get e "time-str")))
|
||||||
(or entries (list)))
|
(or entries (list)))
|
||||||
(map (lambda (c)
|
(map (lambda (c)
|
||||||
(~events-post-nav-calendar
|
(~page/post-nav-calendar
|
||||||
:href (get c "href") :nav-btn nav-btn :name (get c "name")))
|
:href (get c "href") :nav-btn nav-btn :name (get c "name")))
|
||||||
(or calendars (list))))
|
(or calendars (list))))
|
||||||
:hyperscript hyperscript)))
|
:hyperscript hyperscript)))
|
||||||
|
|
||||||
;; Entry posts panel from data
|
;; Entry posts panel from data
|
||||||
(defcomp ~events-entry-posts-panel-from-data (&key entry-id posts search-url)
|
(defcomp ~page/entry-posts-panel-from-data (&key entry-id posts search-url)
|
||||||
(~events-entry-posts-panel
|
(~page/entry-posts-panel
|
||||||
:posts (if (empty? (or posts (list)))
|
:posts (if (empty? (or posts (list)))
|
||||||
(~events-entry-posts-none)
|
(~page/entry-posts-none)
|
||||||
(~events-entry-posts-list
|
(~page/entry-posts-list
|
||||||
:items (<> (map (lambda (p)
|
:items (<> (map (lambda (p)
|
||||||
(~events-entry-post-item
|
(~page/entry-post-item
|
||||||
: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")
|
:title (get p "title")
|
||||||
:del-url (get p "del-url") :entry-id entry-id
|
:del-url (get p "del-url") :entry-id entry-id
|
||||||
:csrf-hdr (get p "csrf-hdr")))
|
:csrf-hdr (get p "csrf-hdr")))
|
||||||
@@ -532,11 +532,11 @@
|
|||||||
:search-url search-url :entry-id entry-id))
|
:search-url search-url :entry-id entry-id))
|
||||||
|
|
||||||
;; CRUD list/panel from data — shared by calendars + markets
|
;; 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)))
|
(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)
|
(<> (map (lambda (item)
|
||||||
(~crud-item
|
(~shared:misc/crud-item
|
||||||
:href (get item "href") :name (get item "name") :slug (get item "slug")
|
:href (get item "href") :name (get item "name") :slug (get item "slug")
|
||||||
:del-url (get item "del-url") :csrf-hdr (get item "csrf-hdr")
|
:del-url (get item "del-url") :csrf-hdr (get item "csrf-hdr")
|
||||||
:list-id list-id
|
:list-id list-id
|
||||||
@@ -544,84 +544,84 @@
|
|||||||
:confirm-text (get item "confirm-text")))
|
:confirm-text (get item "confirm-text")))
|
||||||
items))))
|
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)
|
placeholder btn-label items empty-msg)
|
||||||
(~crud-panel
|
(~shared:misc/crud-panel
|
||||||
:form (when can-create
|
:form (when can-create
|
||||||
(~crud-create-form
|
(~shared:misc/crud-create-form
|
||||||
:create-url create-url :csrf csrf :errors-id errors-id
|
:create-url create-url :csrf csrf :errors-id errors-id
|
||||||
:list-id list-id :placeholder placeholder :btn-label btn-label))
|
: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))
|
:list-id list-id))
|
||||||
|
|
||||||
;; Post nav admin cog
|
;; 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"
|
(div :class "relative nav-group"
|
||||||
(a :href href :class aclass
|
(a :href href :class aclass
|
||||||
(i :class "fa fa-cog" :aria-hidden "true"))))
|
(i :class "fa fa-cog" :aria-hidden "true"))))
|
||||||
|
|
||||||
;; Post nav from data — calendar links + container nav + admin
|
;; 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)
|
has-admin admin-href aclass)
|
||||||
(<>
|
(<>
|
||||||
(map (lambda (c)
|
(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
|
:label (get c "name") :select-colours select-colours
|
||||||
:is-selected (get c "is-selected")))
|
:is-selected (get c "is-selected")))
|
||||||
(or calendars (list)))
|
(or calendars (list)))
|
||||||
(when container-nav container-nav)
|
(when container-nav container-nav)
|
||||||
(when has-admin
|
(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
|
;; 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)
|
:label "Slots" :select-colours select-colours)
|
||||||
(when is-admin
|
(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))))
|
:select-colours select-colours))))
|
||||||
|
|
||||||
;; Calendar admin nav from data
|
;; 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)
|
(<> (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))
|
:select-colours select-colours))
|
||||||
(or links (list)))))
|
(or links (list)))))
|
||||||
|
|
||||||
;; Day nav from data — confirmed entries + admin link
|
;; 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))))
|
(when (not (empty? (or entries (list))))
|
||||||
(~events-day-entries-nav
|
(~day/entries-nav
|
||||||
:inner (<> (map (lambda (e)
|
: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")))
|
:href (get e "href") :name (get e "name") :time-str (get e "time-str")))
|
||||||
entries))))
|
entries))))
|
||||||
(when is-admin
|
(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
|
;; 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)
|
(map (lambda (item)
|
||||||
(~events-post-search-item
|
(~forms/post-search-item
|
||||||
:post-url (get item "post-url") :entry-id (get item "entry-id")
|
:post-url (get item "post-url") :entry-id (get item "entry-id")
|
||||||
:csrf (get item "csrf") :post-id (get item "post-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")))
|
:title (get item "title")))
|
||||||
(or items (list)))
|
(or items (list)))
|
||||||
(cond
|
(cond
|
||||||
(has-more (~events-post-search-sentinel :page page :next-url next-url))
|
(has-more (~forms/post-search-sentinel :page page :next-url next-url))
|
||||||
((not (empty? (or items (list)))) (~events-post-search-end))
|
((not (empty? (or items (list)))) (~forms/post-search-end))
|
||||||
(true ""))))
|
(true ""))))
|
||||||
|
|
||||||
;; Entry options from data — state-driven button composition
|
;; Entry options from data — state-driven button composition
|
||||||
(defcomp ~events-entry-options-from-data (&key entry-id state buttons)
|
(defcomp ~page/entry-options-from-data (&key entry-id state buttons)
|
||||||
(~events-entry-options
|
(~admin/entry-options
|
||||||
:entry-id entry-id
|
:entry-id entry-id
|
||||||
:buttons (<> (map (lambda (b)
|
:buttons (<> (map (lambda (b)
|
||||||
(~events-entry-option-button
|
(~admin/entry-option-button
|
||||||
:url (get b "url") :target (str "#calendar_entry_options_" entry-id)
|
:url (get b "url") :target (str "#calendar_entry_options_" entry-id)
|
||||||
:csrf (get b "csrf") :btn-type (get b "btn-type")
|
:csrf (get b "csrf") :btn-type (get b "btn-type")
|
||||||
:action-btn (get b "action-btn")
|
:action-btn (get b "action-btn")
|
||||||
|
|||||||
@@ -1,12 +1,12 @@
|
|||||||
;; Events payments components
|
;; 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"
|
(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
|
:placeholder placeholder :input-cls input-cls :sumup-configured sumup-configured
|
||||||
:checkout-prefix checkout-prefix :sx-select "#payments-panel")))
|
: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")
|
(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
|
(form :class "mt-4 flex gap-2 items-end" :sx-post create-url
|
||||||
@@ -20,15 +20,15 @@
|
|||||||
:placeholder "e.g. Farm Shop, Bakery"))
|
:placeholder "e.g. Farm Shop, Bakery"))
|
||||||
(button :type "submit" :class "border rounded px-3 py-2" "Add market"))))
|
(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"
|
(section :class "p-4"
|
||||||
form
|
form
|
||||||
(div :id "markets-list" :class "mt-6" list)))
|
(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."))
|
(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 "mt-6 border rounded-lg p-4"
|
||||||
(div :class "flex items-center justify-between gap-3"
|
(div :class "flex items-center justify-between gap-3"
|
||||||
(a :class "flex items-baseline gap-3" :href href
|
(a :class "flex items-baseline gap-3" :href href
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
;; Events ticket components
|
;; 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"
|
(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 items-start justify-between gap-4"
|
||||||
(div :class "flex-1 min-w-0"
|
(div :class "flex-1 min-w-0"
|
||||||
@@ -12,7 +12,7 @@
|
|||||||
badge
|
badge
|
||||||
(span :class "text-xs text-stone-400 font-mono" (str code-prefix "..."))))))
|
(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
|
(section :id "tickets-list" :class list-container
|
||||||
(h1 :class "text-2xl font-bold mb-6" "My Tickets")
|
(h1 :class "text-2xl font-bold mb-6" "My Tickets")
|
||||||
(if has-tickets
|
(if has-tickets
|
||||||
@@ -22,9 +22,9 @@
|
|||||||
(p :class "text-lg" "No tickets yet")
|
(p :class "text-lg" "No tickets yet")
|
||||||
(p :class "text-sm mt-1" "Tickets will appear here after you purchase them.")))))
|
(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
|
(defcomp ~tickets/detail (&key (list-container :as string) (back-href :as string) (header-bg :as string) (entry-name :as string) badge
|
||||||
type-name code time-date time-range cal-name
|
(type-name :as string?) (code :as string) (time-date :as string?) (time-range :as string?) (cal-name :as string?)
|
||||||
type-desc checkin-str qr-script)
|
(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")
|
(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"
|
(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")
|
(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 :src "https://cdn.jsdelivr.net/npm/qrcode@1.5.3/build/qrcode.min.js")
|
||||||
(script qr-script)))
|
(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 "rounded-xl border " border " " bg " p-4 text-center")
|
||||||
(div :class (str "text-2xl font-bold " text-cls) value)
|
(div :class (str "text-2xl font-bold " text-cls) value)
|
||||||
(div :class (str "text-xs " label-cls " uppercase tracking-wide") label)))
|
(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))
|
(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"
|
(form :sx-post checkin-url :sx-target (str "#ticket-row-" code) :sx-swap "outerHTML"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(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"
|
(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")))
|
(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"
|
(span :class "text-xs text-blue-600"
|
||||||
(i :class "fa fa-check-circle" :aria-hidden "true") (str " " time-str)))
|
(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)
|
(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" (span :class "font-mono text-xs" code-short))
|
||||||
(td :class "px-4 py-3" (div :class "font-medium" entry-name) date)
|
(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" badge)
|
||||||
(td :class "px-4 py-3" action)))
|
(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
|
(section :id "ticket-admin" :class list-container
|
||||||
(h1 :class "text-2xl font-bold mb-6" "Ticket Admin")
|
(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)
|
(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))
|
(tbody :class "divide-y divide-stone-100" rows))
|
||||||
(div :class "px-6 py-8 text-center text-stone-500" "No tickets yet"))))))
|
(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"
|
(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))
|
(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)
|
(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" (span :class "font-mono text-xs" code-short))
|
||||||
(td :class "px-4 py-3" (div :class "font-medium" entry-name) date)
|
(td :class "px-4 py-3" (div :class "font-medium" entry-name) date)
|
||||||
@@ -127,65 +127,65 @@
|
|||||||
(span :class "text-xs text-blue-600"
|
(span :class "text-xs text-blue-600"
|
||||||
(i :class "fa fa-check-circle" :aria-hidden "true") (str " " time-str)))))
|
(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"
|
(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))
|
(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))
|
(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))
|
(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))
|
(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))
|
(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)))
|
(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)))
|
(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"
|
(form :sx-post checkin-url :sx-target (str "#checkin-action-" code) :sx-swap "innerHTML"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||||
(button :type "submit"
|
(button :type "submit"
|
||||||
:class "px-6 py-3 bg-blue-600 text-white rounded-lg hover:bg-blue-700 transition font-semibold text-lg"
|
: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")))
|
(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"
|
(div :class "text-blue-600 text-center"
|
||||||
(i :class "fa fa-check-circle text-3xl" :aria-hidden "true")
|
(i :class "fa fa-check-circle text-3xl" :aria-hidden "true")
|
||||||
(div :class "text-sm font-medium mt-1" "Checked In")))
|
(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"
|
(div :class "text-red-600 text-center"
|
||||||
(i :class "fa fa-times-circle text-3xl" :aria-hidden "true")
|
(i :class "fa fa-times-circle text-3xl" :aria-hidden "true")
|
||||||
(div :class "text-sm font-medium mt-1" "Cancelled")))
|
(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 "rounded-lg border border-stone-200 bg-stone-50 p-4"
|
||||||
(div :class "flex items-start justify-between gap-4"
|
(div :class "flex items-start justify-between gap-4"
|
||||||
(div :class "flex-1" info)
|
(div :class "flex-1" info)
|
||||||
(div :id (str "checkin-action-" code) action))))
|
(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)
|
(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 font-mono text-xs" code-short)
|
||||||
(td :class "px-4 py-2" type-name)
|
(td :class "px-4 py-2" type-name)
|
||||||
(td :class "px-4 py-2" badge)
|
(td :class "px-4 py-2" badge)
|
||||||
(td :class "px-4 py-2" action)))
|
(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"
|
(form :sx-post checkin-url :sx-target (str "#entry-ticket-row-" code) :sx-swap "outerHTML"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(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"
|
(button :type "submit" :class "px-3 py-1 bg-blue-600 text-white text-xs rounded hover:bg-blue-700"
|
||||||
"Check in")))
|
"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"
|
(div :class "overflow-x-auto rounded-xl border border-stone-200"
|
||||||
(table :class "w-full text-sm"
|
(table :class "w-full text-sm"
|
||||||
(thead :class "bg-stone-50"
|
(thead :class "bg-stone-50"
|
||||||
@@ -195,10 +195,10 @@
|
|||||||
(th :class "px-4 py-2 text-left font-medium text-stone-600" "Actions")))
|
(th :class "px-4 py-2 text-left font-medium text-stone-600" "Actions")))
|
||||||
(tbody :class "divide-y divide-stone-100" rows))))
|
(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"))
|
(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 "space-y-4"
|
||||||
(div :class "flex items-center justify-between"
|
(div :class "flex items-center justify-between"
|
||||||
(h3 :class "text-lg font-semibold" (str "Tickets for: " entry-name))
|
(h3 :class "text-lg font-semibold" (str "Tickets for: " entry-name))
|
||||||
@@ -211,72 +211,72 @@
|
|||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
;; My tickets panel from data
|
;; My tickets panel from data
|
||||||
(defcomp ~events-tickets-panel-from-data (&key list-container tickets)
|
(defcomp ~tickets/panel-from-data (&key (list-container :as string) (tickets :as list?))
|
||||||
(~events-tickets-panel
|
(~tickets/panel
|
||||||
:list-container list-container
|
:list-container list-container
|
||||||
:has-tickets (not (empty? (or tickets (list))))
|
:has-tickets (not (empty? (or tickets (list))))
|
||||||
:cards (<> (map (lambda (t)
|
:cards (<> (map (lambda (t)
|
||||||
(~events-ticket-card
|
(~tickets/card
|
||||||
:href (get t "href") :entry-name (get t "entry-name")
|
:href (get t "href") :entry-name (get t "entry-name")
|
||||||
:type-name (get t "type-name") :time-str (get t "time-str")
|
:type-name (get t "type-name") :time-str (get t "time-str")
|
||||||
:cal-name (get t "cal-name")
|
: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")))
|
:code-prefix (get t "code-prefix")))
|
||||||
(or tickets (list))))))
|
(or tickets (list))))))
|
||||||
|
|
||||||
;; Ticket detail from data — uses lg badge variant
|
;; Ticket detail from data — uses lg badge variant
|
||||||
(defcomp ~events-ticket-detail-from-data (&key list-container back-href header-bg entry-name
|
(defcomp ~tickets/detail-from-data (&key (list-container :as string) (back-href :as string) (header-bg :as string) (entry-name :as string)
|
||||||
state type-name code time-date time-range
|
(state :as string) (type-name :as string?) (code :as string) (time-date :as string?) (time-range :as string?)
|
||||||
cal-name type-desc checkin-str qr-script)
|
(cal-name :as string?) (type-desc :as string?) (checkin-str :as string?) (qr-script :as string))
|
||||||
(~events-ticket-detail
|
(~tickets/detail
|
||||||
:list-container list-container :back-href back-href
|
:list-container list-container :back-href back-href
|
||||||
:header-bg header-bg :entry-name entry-name
|
: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
|
:type-name type-name :code code
|
||||||
:time-date time-date :time-range time-range
|
:time-date time-date :time-range time-range
|
||||||
:cal-name cal-name :type-desc type-desc
|
:cal-name cal-name :type-desc type-desc
|
||||||
:checkin-str checkin-str :qr-script qr-script))
|
:checkin-str checkin-str :qr-script qr-script))
|
||||||
|
|
||||||
;; Ticket admin row from data — conditional action column
|
;; Ticket admin row from data — conditional action column
|
||||||
(defcomp ~events-ticket-admin-row-from-data (&key code code-short entry-name date-str
|
(defcomp ~tickets/admin-row-from-data (&key (code :as string) (code-short :as string) (entry-name :as string) (date-str :as string?)
|
||||||
type-name state checkin-url csrf
|
(type-name :as string) (state :as string) (checkin-url :as string) (csrf :as string)
|
||||||
checked-in-time)
|
(checked-in-time :as string?))
|
||||||
(~events-ticket-admin-row
|
(~tickets/admin-row
|
||||||
:code code :code-short code-short
|
:code code :code-short code-short
|
||||||
:entry-name entry-name
|
: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
|
:type-name type-name
|
||||||
:badge (~ticket-state-badge :state state)
|
:badge (~entries/ticket-state-badge :state state)
|
||||||
:action (cond
|
:action (cond
|
||||||
((or (= state "confirmed") (= state "reserved"))
|
((or (= state "confirmed") (= state "reserved"))
|
||||||
(~events-ticket-admin-checkin-form
|
(~tickets/admin-checkin-form
|
||||||
:checkin-url checkin-url :code code :csrf csrf))
|
:checkin-url checkin-url :code code :csrf csrf))
|
||||||
((= state "checked_in")
|
((= 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))))
|
(true nil))))
|
||||||
|
|
||||||
;; Ticket admin panel from data
|
;; Ticket admin panel from data
|
||||||
(defcomp ~events-ticket-admin-panel-from-data (&key list-container lookup-url tickets
|
(defcomp ~tickets/admin-panel-from-data (&key (list-container :as string) (lookup-url :as string) (tickets :as list?)
|
||||||
total confirmed checked-in reserved)
|
(total :as number?) (confirmed :as number?) (checked-in :as number?) (reserved :as number?))
|
||||||
(~events-ticket-admin-panel
|
(~tickets/admin-panel
|
||||||
:list-container list-container
|
:list-container list-container
|
||||||
:stats (<>
|
: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"
|
:text-cls "text-stone-900" :label-cls "text-stone-500"
|
||||||
:value (str (or total 0)) :label "Total")
|
: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"
|
:text-cls "text-emerald-700" :label-cls "text-emerald-600"
|
||||||
:value (str (or confirmed 0)) :label "Confirmed")
|
: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"
|
:text-cls "text-blue-700" :label-cls "text-blue-600"
|
||||||
:value (str (or checked-in 0)) :label "Checked In")
|
: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"
|
:text-cls "text-amber-700" :label-cls "text-amber-600"
|
||||||
:value (str (or reserved 0)) :label "Reserved"))
|
:value (str (or reserved 0)) :label "Reserved"))
|
||||||
:lookup-url lookup-url
|
:lookup-url lookup-url
|
||||||
:has-tickets (not (empty? (or tickets (list))))
|
:has-tickets (not (empty? (or tickets (list))))
|
||||||
:rows (<> (map (lambda (t)
|
: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")
|
:code (get t "code") :code-short (get t "code-short")
|
||||||
:entry-name (get t "entry-name") :date-str (get t "date-str")
|
:entry-name (get t "entry-name") :date-str (get t "date-str")
|
||||||
:type-name (get t "type-name") :state (get t "state")
|
:type-name (get t "type-name") :state (get t "state")
|
||||||
@@ -285,45 +285,45 @@
|
|||||||
(or tickets (list))))))
|
(or tickets (list))))))
|
||||||
|
|
||||||
;; Entry tickets admin from data
|
;; Entry tickets admin from data
|
||||||
(defcomp ~events-entry-tickets-admin-from-data (&key entry-name count-label tickets csrf)
|
(defcomp ~tickets/entry-tickets-admin-from-data (&key (entry-name :as string) (count-label :as string) (tickets :as list?) (csrf :as string))
|
||||||
(~events-entry-tickets-admin-panel
|
(~tickets/entry-tickets-admin-panel
|
||||||
:entry-name entry-name :count-label count-label
|
:entry-name entry-name :count-label count-label
|
||||||
:body (if (empty? (or tickets (list)))
|
:body (if (empty? (or tickets (list)))
|
||||||
(~events-entry-tickets-admin-empty)
|
(~tickets/entry-tickets-admin-empty)
|
||||||
(~events-entry-tickets-admin-table
|
(~tickets/entry-tickets-admin-table
|
||||||
:rows (<> (map (lambda (t)
|
:rows (<> (map (lambda (t)
|
||||||
(~events-entry-tickets-admin-row
|
(~tickets/entry-tickets-admin-row
|
||||||
:code (get t "code") :code-short (get t "code-short")
|
:code (get t "code") :code-short (get t "code-short")
|
||||||
:type-name (get t "type-name")
|
: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
|
:action (cond
|
||||||
((or (= (get t "state") "confirmed") (= (get t "state") "reserved"))
|
((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))
|
:checkin-url (get t "checkin-url") :code (get t "code") :csrf csrf))
|
||||||
((= (get t "state") "checked_in")
|
((= (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))))
|
(true nil))))
|
||||||
(or tickets (list))))))))
|
(or tickets (list))))))))
|
||||||
|
|
||||||
;; Checkin success row from data
|
;; Checkin success row from data
|
||||||
(defcomp ~events-checkin-success-row-from-data (&key code code-short entry-name date-str type-name time-str)
|
(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))
|
||||||
(~events-checkin-success-row
|
(~tickets/checkin-success-row
|
||||||
:code code :code-short code-short
|
:code code :code-short code-short
|
||||||
:entry-name entry-name
|
: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
|
:type-name type-name
|
||||||
:badge (~ticket-state-badge :state "checked_in")
|
:badge (~entries/ticket-state-badge :state "checked_in")
|
||||||
:time-str time-str))
|
:time-str time-str))
|
||||||
|
|
||||||
;; Ticket types table from data
|
;; Ticket types table from data
|
||||||
(defcomp ~events-ticket-types-table-from-data (&key list-container ticket-types action-btn add-url
|
(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 pill-cls hx-select csrf-hdr)
|
(tr-cls :as string) (pill-cls :as string) (hx-select :as string) (csrf-hdr :as string))
|
||||||
(~events-ticket-types-table
|
(~page/ticket-types-table
|
||||||
:list-container list-container
|
:list-container list-container
|
||||||
:rows (if (empty? (or ticket-types (list)))
|
:rows (if (empty? (or ticket-types (list)))
|
||||||
(~events-ticket-types-empty-row)
|
(~page/ticket-types-empty-row)
|
||||||
(<> (map (lambda (tt)
|
(<> (map (lambda (tt)
|
||||||
(~events-ticket-types-row
|
(~page/ticket-types-row
|
||||||
:tr-cls tr-cls :tt-href (get tt "tt-href")
|
:tr-cls tr-cls :tt-href (get tt "tt-href")
|
||||||
:pill-cls pill-cls :hx-select hx-select
|
:pill-cls pill-cls :hx-select hx-select
|
||||||
:tt-name (get tt "tt-name") :cost-str (get tt "cost-str")
|
:tt-name (get tt "tt-name") :cost-str (get tt "cost-str")
|
||||||
@@ -333,23 +333,23 @@
|
|||||||
:action-btn action-btn :add-url add-url))
|
:action-btn action-btn :add-url add-url))
|
||||||
|
|
||||||
;; Lookup result from data
|
;; Lookup result from data
|
||||||
(defcomp ~events-lookup-result-from-data (&key entry-name type-name date-str cal-name
|
(defcomp ~tickets/lookup-result-from-data (&key (entry-name :as string) (type-name :as string?) (date-str :as string?) (cal-name :as string?)
|
||||||
state code checked-in-str
|
(state :as string) (code :as string) (checked-in-str :as string?)
|
||||||
checkin-url csrf)
|
(checkin-url :as string) (csrf :as string))
|
||||||
(~events-lookup-card
|
(~tickets/lookup-card
|
||||||
:info (<>
|
:info (<>
|
||||||
(~events-lookup-info :entry-name entry-name)
|
(~tickets/lookup-info :entry-name entry-name)
|
||||||
(when type-name (~events-lookup-type :type-name type-name))
|
(when type-name (~tickets/lookup-type :type-name type-name))
|
||||||
(when date-str (~events-lookup-date :date-str date-str))
|
(when date-str (~tickets/lookup-date :date-str date-str))
|
||||||
(when cal-name (~events-lookup-cal :cal-name cal-name))
|
(when cal-name (~tickets/lookup-cal :cal-name cal-name))
|
||||||
(~events-lookup-status
|
(~tickets/lookup-status
|
||||||
:badge (~ticket-state-badge :state state) :code code)
|
:badge (~entries/ticket-state-badge :state state) :code code)
|
||||||
(when checked-in-str
|
(when checked-in-str
|
||||||
(~events-lookup-checkin-time :date-str checked-in-str)))
|
(~tickets/lookup-checkin-time :date-str checked-in-str)))
|
||||||
:code code
|
:code code
|
||||||
:action (cond
|
:action (cond
|
||||||
((or (= state "confirmed") (= state "reserved"))
|
((or (= state "confirmed") (= state "reserved"))
|
||||||
(~events-lookup-checkin-btn :checkin-url checkin-url :code code :csrf csrf))
|
(~tickets/lookup-checkin-btn :checkin-url checkin-url :code code :csrf csrf))
|
||||||
((= state "checked_in") (~events-lookup-checked-in))
|
((= state "checked_in") (~tickets/lookup-checked-in))
|
||||||
((= state "cancelled") (~events-lookup-cancelled))
|
((= state "cancelled") (~tickets/lookup-cancelled))
|
||||||
(true nil))))
|
(true nil))))
|
||||||
|
|||||||
@@ -7,8 +7,8 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :events-calendar-admin
|
:layout :events-calendar-admin
|
||||||
:data (calendar-admin-data calendar-slug)
|
:data (calendar-admin-data calendar-slug)
|
||||||
:content (~events-calendar-admin-panel
|
:content (~admin/calendar-admin-panel
|
||||||
:description-content (~events-calendar-description-display
|
:description-content (~calendar/description-display
|
||||||
:description cal-description :edit-url desc-edit-url)
|
:description cal-description :edit-url desc-edit-url)
|
||||||
:csrf csrf :description cal-description))
|
:csrf csrf :description cal-description))
|
||||||
|
|
||||||
@@ -18,7 +18,7 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :events-day-admin
|
:layout :events-day-admin
|
||||||
:data (day-admin-data calendar-slug year month day)
|
:data (day-admin-data calendar-slug year month day)
|
||||||
:content (~events-day-admin-panel))
|
:content (~day/admin-panel))
|
||||||
|
|
||||||
;; Slots listing
|
;; Slots listing
|
||||||
(defpage slots-listing
|
(defpage slots-listing
|
||||||
@@ -26,25 +26,25 @@
|
|||||||
:auth :public
|
:auth :public
|
||||||
:layout :events-slots
|
:layout :events-slots
|
||||||
:data (slots-data calendar-slug)
|
:data (slots-data calendar-slug)
|
||||||
:content (~events-slots-table
|
:content (~page/slots-table
|
||||||
:list-container list-container
|
:list-container list-container
|
||||||
:rows (if has-slots
|
:rows (if has-slots
|
||||||
(<> (map (fn (s)
|
(<> (map (fn (s)
|
||||||
(~events-slots-row
|
(~page/slots-row
|
||||||
:tr-cls tr-cls :slot-href (get s "slot-href")
|
:tr-cls tr-cls :slot-href (get s "slot-href")
|
||||||
:pill-cls pill-cls :hx-select hx-select
|
:pill-cls pill-cls :hx-select hx-select
|
||||||
:slot-name (get s "name") :description (get s "description")
|
:slot-name (get s "name") :description (get s "description")
|
||||||
:flexible (get s "flexible")
|
:flexible (get s "flexible")
|
||||||
:days (if (get s "has-days")
|
:days (if (get s "has-days")
|
||||||
(~events-slot-days-pills :days-inner
|
(~page/slot-days-pills :days-inner
|
||||||
(<> (map (fn (d) (~events-slot-day-pill :day d)) (get s "day-list"))))
|
(<> (map (fn (d) (~page/slot-day-pill :day d)) (get s "day-list"))))
|
||||||
(~events-slot-no-days))
|
(~page/slot-no-days))
|
||||||
:time-str (get s "time-str")
|
:time-str (get s "time-str")
|
||||||
:cost-str (get s "cost-str") :action-btn action-btn
|
:cost-str (get s "cost-str") :action-btn action-btn
|
||||||
:del-url (get s "del-url")
|
:del-url (get s "del-url")
|
||||||
:csrf-hdr csrf-hdr))
|
:csrf-hdr csrf-hdr))
|
||||||
slots-list))
|
slots-list))
|
||||||
(~events-slots-empty-row))
|
(~page/slots-empty-row))
|
||||||
:pre-action pre-action :add-url add-url))
|
:pre-action pre-action :add-url add-url))
|
||||||
|
|
||||||
;; Slot detail
|
;; Slot detail
|
||||||
@@ -53,13 +53,13 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :events-slot
|
:layout :events-slot
|
||||||
:data (slot-data calendar-slug slot-id)
|
:data (slot-data calendar-slug slot-id)
|
||||||
:content (~events-slot-panel
|
:content (~page/slot-panel
|
||||||
:slot-id slot-id-str
|
:slot-id slot-id-str
|
||||||
:list-container list-container
|
:list-container list-container
|
||||||
:days (if has-days
|
:days (if has-days
|
||||||
(~events-slot-days-pills :days-inner
|
(~page/slot-days-pills :days-inner
|
||||||
(<> (map (fn (d) (~events-slot-day-pill :day d)) day-list)))
|
(<> (map (fn (d) (~page/slot-day-pill :day d)) day-list)))
|
||||||
(~events-slot-no-days))
|
(~page/slot-no-days))
|
||||||
:flexible flexible
|
:flexible flexible
|
||||||
:time-str time-str :cost-str cost-str
|
:time-str time-str :cost-str cost-str
|
||||||
:pre-action pre-action :edit-url edit-url))
|
:pre-action pre-action :edit-url edit-url))
|
||||||
@@ -70,29 +70,29 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :events-entry
|
:layout :events-entry
|
||||||
:data (entry-data calendar-slug entry-id)
|
:data (entry-data calendar-slug entry-id)
|
||||||
:content (~events-entry-panel
|
:content (~admin/entry-panel
|
||||||
:entry-id entry-id-str :list-container list-container
|
:entry-id entry-id-str :list-container list-container
|
||||||
:name (~events-entry-field :label "Name"
|
:name (~admin/entry-field :label "Name"
|
||||||
:content (~events-entry-name-field :name entry-name))
|
:content (~admin/entry-name-field :name entry-name))
|
||||||
:slot (~events-entry-field :label "Slot"
|
:slot (~admin/entry-field :label "Slot"
|
||||||
:content (if has-slot
|
:content (if has-slot
|
||||||
(~events-entry-slot-assigned :slot-name slot-name :flex-label flex-label)
|
(~admin/entry-slot-assigned :slot-name slot-name :flex-label flex-label)
|
||||||
(~events-entry-slot-none)))
|
(~admin/entry-slot-none)))
|
||||||
:time (~events-entry-field :label "Time Period"
|
:time (~admin/entry-field :label "Time Period"
|
||||||
:content (~events-entry-time-field :time-str time-str))
|
:content (~admin/entry-time-field :time-str time-str))
|
||||||
:state (~events-entry-field :label "State"
|
:state (~admin/entry-field :label "State"
|
||||||
:content (~events-entry-state-field :entry-id entry-id-str
|
:content (~admin/entry-state-field :entry-id entry-id-str
|
||||||
:badge (~badge :cls state-badge-cls :label state-badge-label)))
|
:badge (~shared:misc/badge :cls state-badge-cls :label state-badge-label)))
|
||||||
:cost (~events-entry-field :label "Cost"
|
:cost (~admin/entry-field :label "Cost"
|
||||||
:content (~events-entry-cost-field :cost cost-str))
|
:content (~admin/entry-cost-field :cost cost-str))
|
||||||
:tickets (~events-entry-field :label "Tickets"
|
:tickets (~admin/entry-field :label "Tickets"
|
||||||
:content (~events-entry-tickets-field :entry-id entry-id-str
|
:content (~admin/entry-tickets-field :entry-id entry-id-str
|
||||||
:tickets-config tickets-config))
|
:tickets-config tickets-config))
|
||||||
:buy buy-form
|
:buy buy-form
|
||||||
:date (~events-entry-field :label "Date"
|
:date (~admin/entry-field :label "Date"
|
||||||
:content (~events-entry-date-field :date-str date-str))
|
:content (~admin/entry-date-field :date-str date-str))
|
||||||
:posts (~events-entry-field :label "Associated Posts"
|
:posts (~admin/entry-field :label "Associated Posts"
|
||||||
:content (~events-entry-posts-field :entry-id entry-id-str
|
:content (~admin/entry-posts-field :entry-id entry-id-str
|
||||||
:posts-panel posts-panel))
|
:posts-panel posts-panel))
|
||||||
:options options-html
|
:options options-html
|
||||||
:pre-action pre-action :edit-url edit-url)
|
:pre-action pre-action :edit-url edit-url)
|
||||||
@@ -104,9 +104,9 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :events-entry-admin
|
:layout :events-entry-admin
|
||||||
:data (entry-admin-data calendar-slug entry-id year month day)
|
: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)
|
:select-colours select-colours :aclass nav-btn :is-selected false)
|
||||||
:menu (~events-admin-placeholder-nav))
|
:menu (~forms/admin-placeholder-nav))
|
||||||
|
|
||||||
;; Ticket types listing
|
;; Ticket types listing
|
||||||
(defpage ticket-types-listing
|
(defpage ticket-types-listing
|
||||||
@@ -114,11 +114,11 @@
|
|||||||
:auth :public
|
:auth :public
|
||||||
:layout :events-ticket-types
|
:layout :events-ticket-types
|
||||||
:data (ticket-types-data calendar-slug entry-id year month day)
|
: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
|
:list-container list-container
|
||||||
:rows (if has-types
|
:rows (if has-types
|
||||||
(<> (map (fn (tt)
|
(<> (map (fn (tt)
|
||||||
(~events-ticket-types-row
|
(~page/ticket-types-row
|
||||||
:tr-cls tr-cls :tt-href (get tt "tt-href")
|
:tr-cls tr-cls :tt-href (get tt "tt-href")
|
||||||
:pill-cls pill-cls :hx-select hx-select
|
:pill-cls pill-cls :hx-select hx-select
|
||||||
:tt-name (get tt "tt-name") :cost-str (get tt "cost-str")
|
:tt-name (get tt "tt-name") :cost-str (get tt "cost-str")
|
||||||
@@ -126,9 +126,9 @@
|
|||||||
:del-url (get tt "del-url")
|
:del-url (get tt "del-url")
|
||||||
:csrf-hdr csrf-hdr))
|
:csrf-hdr csrf-hdr))
|
||||||
types-list))
|
types-list))
|
||||||
(~events-ticket-types-empty-row))
|
(~page/ticket-types-empty-row))
|
||||||
:action-btn action-btn :add-url add-url)
|
:action-btn action-btn :add-url add-url)
|
||||||
:menu (~events-admin-placeholder-nav))
|
:menu (~forms/admin-placeholder-nav))
|
||||||
|
|
||||||
;; Ticket type detail
|
;; Ticket type detail
|
||||||
(defpage ticket-type-detail
|
(defpage ticket-type-detail
|
||||||
@@ -136,13 +136,13 @@
|
|||||||
:auth :admin
|
:auth :admin
|
||||||
:layout :events-ticket-type
|
:layout :events-ticket-type
|
||||||
:data (ticket-type-data calendar-slug entry-id ticket-type-id year month day)
|
: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
|
:ticket-id ticket-id :list-container list-container
|
||||||
:c1 (~events-ticket-type-col :label "Name" :value tt-name)
|
:c1 (~page/ticket-type-col :label "Name" :value tt-name)
|
||||||
:c2 (~events-ticket-type-col :label "Cost" :value cost-str)
|
:c2 (~page/ticket-type-col :label "Cost" :value cost-str)
|
||||||
:c3 (~events-ticket-type-col :label "Count" :value count-str)
|
:c3 (~page/ticket-type-col :label "Count" :value count-str)
|
||||||
:pre-action pre-action :edit-url edit-url)
|
:pre-action pre-action :edit-url edit-url)
|
||||||
:menu (~events-admin-placeholder-nav))
|
:menu (~forms/admin-placeholder-nav))
|
||||||
|
|
||||||
;; My tickets
|
;; My tickets
|
||||||
(defpage my-tickets
|
(defpage my-tickets
|
||||||
@@ -150,16 +150,16 @@
|
|||||||
:auth :public
|
:auth :public
|
||||||
:layout :root
|
:layout :root
|
||||||
:data (tickets-data)
|
:data (tickets-data)
|
||||||
:content (~events-tickets-panel
|
:content (~tickets/panel
|
||||||
:list-container list-container
|
:list-container list-container
|
||||||
:has-tickets has-tickets
|
:has-tickets has-tickets
|
||||||
:cards (when has-tickets
|
:cards (when has-tickets
|
||||||
(<> (map (fn (t)
|
(<> (map (fn (t)
|
||||||
(~events-ticket-card
|
(~tickets/card
|
||||||
:href (get t "href") :entry-name (get t "entry-name")
|
:href (get t "href") :entry-name (get t "entry-name")
|
||||||
:type-name (get t "type-name") :time-str (get t "time-str")
|
:type-name (get t "type-name") :time-str (get t "time-str")
|
||||||
:cal-name (get t "cal-name")
|
: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")))
|
:code-prefix (get t "code-prefix")))
|
||||||
tickets-list)))))
|
tickets-list)))))
|
||||||
|
|
||||||
@@ -169,7 +169,7 @@
|
|||||||
:auth :public
|
:auth :public
|
||||||
:layout :root
|
:layout :root
|
||||||
:data (ticket-detail-data code)
|
:data (ticket-detail-data code)
|
||||||
:content (~events-ticket-detail
|
:content (~tickets/detail
|
||||||
:list-container list-container :back-href back-href
|
:list-container list-container :back-href back-href
|
||||||
:header-bg header-bg :entry-name entry-name
|
: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)
|
: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
|
:auth :admin
|
||||||
:layout :root
|
:layout :root
|
||||||
:data (ticket-admin-data)
|
:data (ticket-admin-data)
|
||||||
:content (~events-ticket-admin-panel
|
:content (~tickets/admin-panel
|
||||||
:list-container list-container
|
:list-container list-container
|
||||||
:stats (<> (map (fn (s)
|
:stats (<> (map (fn (s)
|
||||||
(~events-ticket-admin-stat
|
(~tickets/admin-stat
|
||||||
:border (get s "border") :bg (get s "bg")
|
:border (get s "border") :bg (get s "bg")
|
||||||
:text-cls (get s "text-cls") :label-cls (get s "label-cls")
|
:text-cls (get s "text-cls") :label-cls (get s "label-cls")
|
||||||
:value (get s "value") :label (get s "label")))
|
:value (get s "value") :label (get s "label")))
|
||||||
@@ -196,18 +196,18 @@
|
|||||||
:lookup-url lookup-url :has-tickets has-tickets
|
:lookup-url lookup-url :has-tickets has-tickets
|
||||||
:rows (when has-tickets
|
:rows (when has-tickets
|
||||||
(<> (map (fn (t)
|
(<> (map (fn (t)
|
||||||
(~events-ticket-admin-row
|
(~tickets/admin-row
|
||||||
:code (get t "code") :code-short (get t "code-short")
|
:code (get t "code") :code-short (get t "code-short")
|
||||||
:entry-name (get t "entry-name")
|
:entry-name (get t "entry-name")
|
||||||
:date (when (get t "date-str")
|
: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")
|
: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")
|
: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)
|
:checkin-url (get t "checkin-url") :code (get t "code") :csrf csrf)
|
||||||
(when (get t "is-checked-in")
|
(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)))))
|
admin-tickets)))))
|
||||||
|
|
||||||
;; Markets
|
;; Markets
|
||||||
@@ -216,20 +216,20 @@
|
|||||||
:auth :public
|
:auth :public
|
||||||
:layout :events-markets
|
:layout :events-markets
|
||||||
:data (markets-data)
|
:data (markets-data)
|
||||||
:content (~crud-panel
|
:content (~shared:misc/crud-panel
|
||||||
:list-id "markets-list"
|
:list-id "markets-list"
|
||||||
:form (when can-create
|
: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"
|
:errors-id "market-create-errors" :list-id "markets-list"
|
||||||
:placeholder "e.g. Farm Shop, Bakery" :btn-label "Add market"))
|
:placeholder "e.g. Farm Shop, Bakery" :btn-label "Add market"))
|
||||||
:list (if markets-list
|
:list (if markets-list
|
||||||
(<> (map (fn (m)
|
(<> (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")
|
:slug (get m "slug") :del-url (get m "del-url")
|
||||||
:csrf-hdr (get m "csrf-hdr")
|
:csrf-hdr (get m "csrf-hdr")
|
||||||
:list-id "markets-list"
|
:list-id "markets-list"
|
||||||
:confirm-title "Delete market?"
|
:confirm-title "Delete market?"
|
||||||
:confirm-text "Products will be hidden (soft delete)"))
|
:confirm-text "Products will be hidden (soft delete)"))
|
||||||
markets-list))
|
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"))))
|
: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,
|
ctx, entries, has_more, pending_tickets, page_info,
|
||||||
page, view, ticket_url, next_url, events_url,
|
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)
|
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,
|
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))
|
hdr += await header_child_sx(await _post_header_sx(ctx))
|
||||||
return await full_page_sx(ctx, header_rows=hdr, content=content)
|
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)
|
content = _calendars_main_panel_sx(ctx)
|
||||||
ctx = await _ensure_container_nav(ctx)
|
ctx = await _ensure_container_nav(ctx)
|
||||||
slug = (ctx.get("post") or {}).get("slug", "")
|
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)
|
post_hdr = await _post_header_sx(ctx)
|
||||||
admin_hdr = await post_admin_header_sx(ctx, slug, selected="calendars")
|
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)
|
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:
|
async def render_calendar_page(ctx: dict) -> str:
|
||||||
"""Full page: calendar month view."""
|
"""Full page: calendar month view."""
|
||||||
content = _calendar_main_panel_html(ctx)
|
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)
|
child = await _post_header_sx(ctx) + _calendar_header_sx(ctx)
|
||||||
hdr += await header_child_sx(child)
|
hdr += await header_child_sx(child)
|
||||||
return await full_page_sx(ctx, header_rows=hdr, content=content)
|
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:
|
async def render_day_page(ctx: dict) -> str:
|
||||||
"""Full page: day detail."""
|
"""Full page: day detail."""
|
||||||
content = _day_main_panel_html(ctx)
|
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)
|
child = (await _post_header_sx(ctx)
|
||||||
+ _calendar_header_sx(ctx) + _day_header_sx(ctx))
|
+ _calendar_header_sx(ctx) + _day_header_sx(ctx))
|
||||||
hdr += await header_child_sx(child)
|
hdr += await header_child_sx(child)
|
||||||
|
|||||||
@@ -117,7 +117,7 @@ def _cart_icon_oob(count: int) -> str:
|
|||||||
|
|
||||||
|
|
||||||
def _cart_icon_ctx(count: int) -> dict:
|
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
|
from quart import g
|
||||||
|
|
||||||
blog_url_fn = getattr(g, "blog_url", None)
|
blog_url_fn = getattr(g, "blog_url", None)
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
;; Auth components (choose username — federation-specific)
|
;; Auth components (choose username — federation-specific)
|
||||||
;; Login and check-email components are shared: see shared/sx/templates/auth.sx
|
;; 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"
|
(div :class "py-8 max-w-md mx-auto"
|
||||||
(h1 :class "text-2xl font-bold mb-2" "Choose your username")
|
(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: "
|
(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)))
|
(let ((actor (service "federation" "get-actor-by-username" :username u)))
|
||||||
(<> (str "<!-- fragment:" u " -->")
|
(<> (str "<!-- fragment:" u " -->")
|
||||||
(when (not (nil? actor))
|
(when (not (nil? actor))
|
||||||
(~link-card
|
(~shared:fragments/link-card
|
||||||
:link (app-url "federation"
|
:link (app-url "federation"
|
||||||
(str "/users/" (get actor "preferred_username")))
|
(str "/users/" (get actor "preferred_username")))
|
||||||
:title (or (get actor "display_name")
|
:title (or (get actor "display_name")
|
||||||
@@ -28,7 +28,7 @@
|
|||||||
(let ((actor (service "federation" "get-actor-by-username"
|
(let ((actor (service "federation" "get-actor-by-username"
|
||||||
:username lookup)))
|
:username lookup)))
|
||||||
(when (not (nil? actor))
|
(when (not (nil? actor))
|
||||||
(~link-card
|
(~shared:fragments/link-card
|
||||||
:link (app-url "federation"
|
:link (app-url "federation"
|
||||||
(str "/users/" (get actor "preferred_username")))
|
(str "/users/" (get actor "preferred_username")))
|
||||||
:title (or (get actor "display_name")
|
:title (or (get actor "display_name")
|
||||||
|
|||||||
@@ -2,16 +2,16 @@
|
|||||||
;; Registered via register_sx_layout("social", ...) in __init__.py.
|
;; Registered via register_sx_layout("social", ...) in __init__.py.
|
||||||
|
|
||||||
;; Full page: root header + social header in header-child
|
;; Full page: root header + social header in header-child
|
||||||
(defcomp ~social-layout-full ()
|
(defcomp ~layouts/social-layout-full ()
|
||||||
(<> (~root-header-auto)
|
(<> (~root-header-auto)
|
||||||
(~header-child-sx
|
(~shared:layout/header-child-sx
|
||||||
:inner (~federation-social-header
|
:inner (~social/header
|
||||||
:nav (~federation-social-nav :actor (federation-actor-ctx))))))
|
:nav (~social/nav :actor (federation-actor-ctx))))))
|
||||||
|
|
||||||
;; OOB (HTMX): social header oob + root header oob
|
;; OOB (HTMX): social header oob + root header oob
|
||||||
(defcomp ~social-layout-oob ()
|
(defcomp ~layouts/social-layout-oob ()
|
||||||
(<> (~oob-header-sx
|
(<> (~shared:layout/oob-header-sx
|
||||||
:parent-id "root-header-child"
|
:parent-id "root-header-child"
|
||||||
:row (~federation-social-header
|
:row (~social/header
|
||||||
:nav (~federation-social-nav :actor (federation-actor-ctx))))
|
:nav (~social/nav :actor (federation-actor-ctx))))
|
||||||
(~root-header-auto true)))
|
(~root-header-auto true)))
|
||||||
|
|||||||
@@ -1,9 +1,9 @@
|
|||||||
;; Notification components
|
;; 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))
|
(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 cls
|
||||||
(div :class "flex items-start gap-3"
|
(div :class "flex items-start gap-3"
|
||||||
avatar
|
avatar
|
||||||
@@ -15,14 +15,14 @@
|
|||||||
preview
|
preview
|
||||||
(div :class "text-xs text-stone-400 mt-1" time)))))
|
(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))
|
(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)
|
(h1 :class "text-2xl font-bold mb-6" "Notifications") notifs)
|
||||||
|
|
||||||
;; Assembled notification card — replaces Python _notification_sx
|
;; 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") "?"))
|
(let* ((from-name (or (get notif "from_actor_name") "?"))
|
||||||
(from-username (or (get notif "from_actor_username") ""))
|
(from-username (or (get notif "from_actor_username") ""))
|
||||||
(from-domain (or (get notif "from_actor_domain") ""))
|
(from-domain (or (get notif "from_actor_domain") ""))
|
||||||
@@ -44,9 +44,9 @@
|
|||||||
((= ntype "mention") "mentioned you")
|
((= ntype "mention") "mentioned you")
|
||||||
((= ntype "reply") "replied to your post")
|
((= ntype "reply") "replied to your post")
|
||||||
(true ""))))
|
(true ""))))
|
||||||
(~federation-notification-card
|
(~notifications/card
|
||||||
:cls (str "bg-white rounded-lg shadow-sm border border-stone-200 p-4" border)
|
:cls (str "bg-white rounded-lg shadow-sm border border-stone-200 p-4" border)
|
||||||
:avatar (~avatar
|
:avatar (~shared:misc/avatar
|
||||||
:src from-icon
|
:src from-icon
|
||||||
:cls (if from-icon "w-8 h-8 rounded-full"
|
: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")
|
"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-username (escape from-username)
|
||||||
:from-domain (if from-domain (str "@" (escape from-domain)) "")
|
:from-domain (if from-domain (str "@" (escape from-domain)) "")
|
||||||
:action-text action-text
|
:action-text action-text
|
||||||
:preview (when preview (~federation-notification-preview :preview (escape preview)))
|
:preview (when preview (~notifications/preview :preview (escape preview)))
|
||||||
:time created)))
|
:time created)))
|
||||||
|
|
||||||
;; Assembled notifications content — replaces Python _notifications_content_sx
|
;; Assembled notifications content — replaces Python _notifications_content_sx
|
||||||
(defcomp ~federation-notifications-content (&key notifications)
|
(defcomp ~notifications/content (&key (notifications :as list))
|
||||||
(~federation-notifications-page
|
(~notifications/page
|
||||||
:notifs (if (empty? notifications)
|
:notifs (if (empty? notifications)
|
||||||
(~empty-state :message "No notifications yet." :cls "text-stone-500")
|
(~shared:misc/empty-state :message "No notifications yet." :cls "text-stone-500")
|
||||||
(~federation-notifications-list
|
(~notifications/list
|
||||||
:items (map (lambda (n)
|
:items (map (lambda (n)
|
||||||
(~federation-notification-from-data :notif n))
|
(~notifications/from-data :notif n))
|
||||||
notifications)))))
|
notifications)))))
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
;; Profile and actor timeline components
|
;; 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 "bg-white rounded-lg shadow-sm border border-stone-200 p-6 mb-6"
|
||||||
(div :class "flex items-center gap-4"
|
(div :class "flex items-center gap-4"
|
||||||
avatar
|
avatar
|
||||||
@@ -10,39 +10,39 @@
|
|||||||
summary)
|
summary)
|
||||||
follow)))
|
follow)))
|
||||||
|
|
||||||
(defcomp ~federation-actor-timeline-layout (&key header timeline)
|
(defcomp ~profile/actor-timeline-layout (&key header timeline)
|
||||||
header
|
header
|
||||||
(div :id "timeline" timeline))
|
(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"
|
(div :class "flex-shrink-0"
|
||||||
(form :method "post" :action action
|
(form :method "post" :action action
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||||
(input :type "hidden" :name "actor_url" :value actor-url)
|
(input :type "hidden" :name "actor_url" :value actor-url)
|
||||||
(button :type "submit" :class cls label))))
|
(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)))
|
(div :class "text-sm text-stone-600 mt-2" (~rich-text :html summary)))
|
||||||
|
|
||||||
;; Public profile page
|
;; 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))
|
(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 "bg-white rounded-lg shadow p-4"
|
||||||
(div :class "flex justify-between items-start"
|
(div :class "flex justify-between items-start"
|
||||||
(span :class "font-medium" activity-type)
|
(span :class "font-medium" activity-type)
|
||||||
(span :class "text-sm text-stone-400" published))
|
(span :class "text-sm text-stone-400" published))
|
||||||
obj-type))
|
obj-type))
|
||||||
|
|
||||||
(defcomp ~federation-activities-list (&key items)
|
(defcomp ~profile/activities-list (&key (items :as list))
|
||||||
(div :class "space-y-4" items))
|
(div :class "space-y-4" items))
|
||||||
|
|
||||||
(defcomp ~federation-activities-empty ()
|
(defcomp ~profile/activities-empty ()
|
||||||
(p :class "text-stone-500" "No activities yet."))
|
(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 "py-8"
|
||||||
(div :class "bg-white rounded-lg shadow p-6 mb-6"
|
(div :class "bg-white rounded-lg shadow p-6 mb-6"
|
||||||
(h1 :class "text-2xl font-bold" display-name)
|
(h1 :class "text-2xl font-bold" display-name)
|
||||||
@@ -51,11 +51,11 @@
|
|||||||
(h2 :class "text-xl font-bold mb-4" activities-heading)
|
(h2 :class "text-xl font-bold mb-4" activities-heading)
|
||||||
activities))
|
activities))
|
||||||
|
|
||||||
(defcomp ~federation-profile-summary-text (&key text)
|
(defcomp ~profile/summary-text (&key (text :as string))
|
||||||
(p :class "mt-2" text))
|
(p :class "mt-2" text))
|
||||||
|
|
||||||
;; Assembled actor timeline content — replaces Python _actor_timeline_content_sx
|
;; 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") ""))
|
(let* ((display-name (or (get remote-actor "display_name") (get remote-actor "preferred_username") ""))
|
||||||
(icon-url (get remote-actor "icon_url"))
|
(icon-url (get remote-actor "icon_url"))
|
||||||
(summary (get remote-actor "summary"))
|
(summary (get remote-actor "summary"))
|
||||||
@@ -63,9 +63,9 @@
|
|||||||
(csrf (csrf-token))
|
(csrf (csrf-token))
|
||||||
(initial (if (and (not icon-url) display-name)
|
(initial (if (and (not icon-url) display-name)
|
||||||
(upper (slice display-name 0 1)) "?")))
|
(upper (slice display-name 0 1)) "?")))
|
||||||
(~federation-actor-timeline-layout
|
(~profile/actor-timeline-layout
|
||||||
:header (~federation-actor-profile-header
|
:header (~profile/actor-profile-header
|
||||||
:avatar (~avatar
|
:avatar (~shared:misc/avatar
|
||||||
:src icon-url
|
:src icon-url
|
||||||
:cls (if icon-url "w-16 h-16 rounded-full"
|
: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")
|
"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)
|
:display-name (escape display-name)
|
||||||
:username (escape (or (get remote-actor "preferred_username") ""))
|
:username (escape (or (get remote-actor "preferred_username") ""))
|
||||||
:domain (escape (or (get remote-actor "domain") ""))
|
: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
|
:follow (when actor
|
||||||
(if is-following
|
(if is-following
|
||||||
(~federation-follow-form
|
(~profile/follow-form
|
||||||
:action (url-for "social.unfollow") :csrf csrf :actor-url actor-url
|
:action (url-for "social.unfollow") :csrf csrf :actor-url actor-url
|
||||||
:label "Unfollow"
|
:label "Unfollow"
|
||||||
:cls "border border-stone-300 rounded px-4 py-2 hover:bg-stone-100")
|
: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
|
:action (url-for "social.follow") :csrf csrf :actor-url actor-url
|
||||||
:label "Follow"
|
:label "Follow"
|
||||||
:cls "bg-stone-800 text-white rounded px-4 py-2 hover:bg-stone-700"))))
|
: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
|
:items items :timeline-type "actor" :actor actor
|
||||||
:next-url (when (not (empty? items))
|
:next-url (when (not (empty? items))
|
||||||
(url-for "social.actor_timeline_page"
|
(url-for "social.actor_timeline_page"
|
||||||
@@ -92,14 +92,14 @@
|
|||||||
:before (get (last items) "before_cursor")))))))
|
:before (get (last items) "before_cursor")))))))
|
||||||
|
|
||||||
;; Data-driven activities list (replaces Python loop in render_profile_page)
|
;; 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)))
|
(if (empty? (or activities (list)))
|
||||||
(~federation-activities-empty)
|
(~profile/activities-empty)
|
||||||
(~federation-activities-list
|
(~profile/activities-list
|
||||||
:items (<> (map (lambda (a)
|
:items (<> (map (lambda (a)
|
||||||
(~federation-activity-card
|
(~profile/activity-card
|
||||||
:activity-type (get a "activity_type")
|
:activity-type (get a "activity_type")
|
||||||
:published (get a "published")
|
:published (get a "published")
|
||||||
:obj-type (when (get a "object_type")
|
: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)))))
|
activities)))))
|
||||||
|
|||||||
@@ -1,37 +1,37 @@
|
|||||||
;; Search and actor card components
|
;; Search and actor card components
|
||||||
|
|
||||||
;; Aliases — delegate to shared ~avatar
|
;; Aliases — delegate to shared ~shared:misc/avatar
|
||||||
(defcomp ~federation-actor-avatar-img (&key src cls)
|
(defcomp ~search/actor-avatar-img (&key (src :as string) (cls :as string))
|
||||||
(~avatar :src src :cls cls))
|
(~shared:misc/avatar :src src :cls cls))
|
||||||
|
|
||||||
(defcomp ~federation-actor-avatar-placeholder (&key cls initial)
|
(defcomp ~search/actor-avatar-placeholder (&key (cls :as string) (initial :as string))
|
||||||
(~avatar :cls cls :initial initial))
|
(~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))
|
(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"
|
(a :href href :target "_blank" :rel "noopener"
|
||||||
:class "font-semibold text-stone-900 hover:underline" name))
|
: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)))
|
(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"
|
(div :class "flex-shrink-0"
|
||||||
(form :method "post" :action action :sx-post action :sx-target "closest article" :sx-swap "outerHTML"
|
(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 "csrf_token" :value csrf)
|
||||||
(input :type "hidden" :name "actor_url" :value actor-url)
|
(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"))))
|
(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"
|
(div :class "flex-shrink-0"
|
||||||
(form :method "post" :action action :sx-post action :sx-target "closest article" :sx-swap "outerHTML"
|
(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 "csrf_token" :value csrf)
|
||||||
(input :type "hidden" :name "actor_url" :value actor-url)
|
(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))))
|
(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
|
(article :class cls :id id
|
||||||
avatar
|
avatar
|
||||||
(div :class "flex-1 min-w-0"
|
(div :class "flex-1 min-w-0"
|
||||||
@@ -41,7 +41,7 @@
|
|||||||
button))
|
button))
|
||||||
|
|
||||||
;; Data-driven actor card (replaces Python _actor_card_sx loop)
|
;; 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"))
|
(let* ((icon-url (get d "icon_url"))
|
||||||
(display-name (get d "display_name"))
|
(display-name (get d "display_name"))
|
||||||
(username (get d "username"))
|
(username (get d "username"))
|
||||||
@@ -49,42 +49,42 @@
|
|||||||
(actor-url (get d "actor_url"))
|
(actor-url (get d "actor_url"))
|
||||||
(safe-id (get d "safe_id"))
|
(safe-id (get d "safe_id"))
|
||||||
(initial (or (get d "initial") "?"))
|
(initial (or (get d "initial") "?"))
|
||||||
(avatar (~avatar
|
(avatar (~shared:misc/avatar
|
||||||
:src icon-url
|
:src icon-url
|
||||||
:cls (if icon-url "w-12 h-12 rounded-full"
|
: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")
|
"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)))
|
:initial (when (not icon-url) initial)))
|
||||||
(name-sx (if (get d "external_link")
|
(name-sx (if (get d "external_link")
|
||||||
(~federation-actor-name-link-external :href (get d "name_href") :name display-name)
|
(~search/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 :href (get d "name_href") :name display-name)))
|
||||||
(summary-sx (when (get d "summary")
|
(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"))
|
(is-followed (get d "is_followed"))
|
||||||
(button (when has-actor
|
(button (when has-actor
|
||||||
(if (or (= list-type "following") is-followed)
|
(if (or (= list-type "following") is-followed)
|
||||||
(~federation-unfollow-button :action unfollow-url :csrf csrf :actor-url actor-url)
|
(~search/unfollow-button :action unfollow-url :csrf csrf :actor-url actor-url)
|
||||||
(~federation-follow-button :action follow-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"))))))
|
: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"
|
: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)
|
:id (str "actor-" safe-id)
|
||||||
:avatar avatar :name name-sx :username username :domain domain
|
:avatar avatar :name name-sx :username username :domain domain
|
||||||
:summary summary-sx :button button)))
|
:summary summary-sx :button button)))
|
||||||
|
|
||||||
;; Data-driven actor list (replaces Python _search_results_sx / _actor_list_items_sx loops)
|
;; 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
|
(defcomp ~search/actor-list-from-data (&key (actors :as list) (next-url :as string?) (has-actor :as boolean) (csrf :as string)
|
||||||
follow-url unfollow-url list-type)
|
(follow-url :as string) (unfollow-url :as string) (list-type :as string))
|
||||||
(<>
|
(<>
|
||||||
(map (lambda (d)
|
(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))
|
:follow-url follow-url :unfollow-url unfollow-url :list-type list-type))
|
||||||
(or actors (list)))
|
(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))
|
(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")
|
(h1 :class "text-2xl font-bold mb-6" "Search")
|
||||||
(form :method "get" :action search-url :class "mb-6"
|
(form :method "get" :action search-url :class "mb-6"
|
||||||
:sx-get search-page-url :sx-target "#search-results" :sx-push-url search-url
|
:sx-get search-page-url :sx-target "#search-results" :sx-push-url search-url
|
||||||
@@ -97,7 +97,7 @@
|
|||||||
(div :id "search-results" results))
|
(div :id "search-results" results))
|
||||||
|
|
||||||
;; Following / Followers list page
|
;; 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 " "
|
(h1 :class "text-2xl font-bold mb-6" title " "
|
||||||
(span :class "text-stone-400 font-normal" count-str))
|
(span :class "text-stone-400 font-normal" count-str))
|
||||||
(div :id "actor-list" items))
|
(div :id "actor-list" items))
|
||||||
@@ -106,7 +106,7 @@
|
|||||||
;; Assembled actor card — replaces Python _actor_card_sx
|
;; 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") ""))
|
(let* ((display-name (or (get a "display_name") (get a "preferred_username") ""))
|
||||||
(username (or (get a "preferred_username") ""))
|
(username (or (get a "preferred_username") ""))
|
||||||
(domain (or (get a "domain") ""))
|
(domain (or (get a "domain") ""))
|
||||||
@@ -119,81 +119,81 @@
|
|||||||
(upper (slice (or display-name username) 0 1)) "?"))
|
(upper (slice (or display-name username) 0 1)) "?"))
|
||||||
(csrf (csrf-token))
|
(csrf (csrf-token))
|
||||||
(is-followed (contains? (or followed-urls (list)) actor-url)))
|
(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"
|
: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)
|
:id (str "actor-" safe-id)
|
||||||
:avatar (~avatar
|
:avatar (~shared:misc/avatar
|
||||||
:src icon-url
|
:src icon-url
|
||||||
:cls (if icon-url "w-12 h-12 rounded-full"
|
: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")
|
"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))
|
:initial (when (not icon-url) initial))
|
||||||
:name (if (and (or (= list-type "following") (= list-type "search")) aid)
|
: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)
|
:href (url-for "social.defpage_actor_timeline" :id aid)
|
||||||
:name (escape display-name))
|
:name (escape display-name))
|
||||||
(~federation-actor-name-link-external
|
(~search/actor-name-link-external
|
||||||
:href (str "https://" domain "/@" username)
|
:href (str "https://" domain "/@" username)
|
||||||
:name (escape display-name)))
|
:name (escape display-name)))
|
||||||
:username (escape username)
|
:username (escape username)
|
||||||
:domain (escape domain)
|
:domain (escape domain)
|
||||||
:summary (when summary (~federation-actor-summary :summary summary))
|
:summary (when summary (~search/actor-summary :summary summary))
|
||||||
:button (when actor
|
:button (when actor
|
||||||
(if (or (= list-type "following") is-followed)
|
(if (or (= list-type "following") is-followed)
|
||||||
(~federation-unfollow-button
|
(~search/unfollow-button
|
||||||
:action (url-for "social.unfollow") :csrf csrf :actor-url actor-url)
|
: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
|
:action (url-for "social.follow") :csrf csrf :actor-url actor-url
|
||||||
:label (if (= list-type "followers") "Follow Back" "Follow")))))))
|
:label (if (= list-type "followers") "Follow Back" "Follow")))))))
|
||||||
|
|
||||||
;; Assembled search content — replaces Python _search_content_sx
|
;; Assembled search content — replaces Python _search_content_sx
|
||||||
(defcomp ~federation-search-content (&key query actors total followed-urls actor)
|
(defcomp ~search/content (&key (query :as string?) (actors :as list) (total :as number) (followed-urls :as list) actor)
|
||||||
(~federation-search-page
|
(~search/page
|
||||||
:search-url (url-for "social.defpage_search")
|
:search-url (url-for "social.defpage_search")
|
||||||
:search-page-url (url-for "social.search_page")
|
:search-page-url (url-for "social.search_page")
|
||||||
:query (escape (or query ""))
|
:query (escape (or query ""))
|
||||||
:info (cond
|
:info (cond
|
||||||
((and query (> total 0))
|
((and query (> total 0))
|
||||||
(~federation-search-info
|
(~search/info
|
||||||
:cls "text-sm text-stone-500 mb-4"
|
:cls "text-sm text-stone-500 mb-4"
|
||||||
:text (str total " result" (pluralize total) " for " (escape query))))
|
:text (str total " result" (pluralize total) " for " (escape query))))
|
||||||
(query
|
(query
|
||||||
(~federation-search-info
|
(~search/info
|
||||||
:cls "text-stone-500 mb-4"
|
:cls "text-stone-500 mb-4"
|
||||||
:text (str "No results found for " (escape query))))
|
:text (str "No results found for " (escape query))))
|
||||||
(true nil))
|
(true nil))
|
||||||
:results (when (not (empty? actors))
|
:results (when (not (empty? actors))
|
||||||
(<>
|
(<>
|
||||||
(map (lambda (a)
|
(map (lambda (a)
|
||||||
(~federation-actor-card-from-data
|
(~search/actor-card-from-data
|
||||||
:a a :actor actor :followed-urls followed-urls :list-type "search"))
|
:a a :actor actor :followed-urls followed-urls :list-type "search"))
|
||||||
actors)
|
actors)
|
||||||
(when (>= (len actors) 20)
|
(when (>= (len actors) 20)
|
||||||
(~federation-scroll-sentinel
|
(~social/scroll-sentinel
|
||||||
:url (url-for "social.search_page" :q query :page 2)))))))
|
:url (url-for "social.search_page" :q query :page 2)))))))
|
||||||
|
|
||||||
;; Assembled following/followers content — replaces Python _following_content_sx etc.
|
;; Assembled following/followers content — replaces Python _following_content_sx etc.
|
||||||
(defcomp ~federation-following-content (&key actors total actor)
|
(defcomp ~search/following-content (&key (actors :as list) (total :as number) actor)
|
||||||
(~federation-actor-list-page
|
(~search/actor-list-page
|
||||||
:title "Following" :count-str (str "(" total ")")
|
:title "Following" :count-str (str "(" total ")")
|
||||||
:items (when (not (empty? actors))
|
:items (when (not (empty? actors))
|
||||||
(<>
|
(<>
|
||||||
(map (lambda (a)
|
(map (lambda (a)
|
||||||
(~federation-actor-card-from-data
|
(~search/actor-card-from-data
|
||||||
:a a :actor actor :followed-urls (list) :list-type "following"))
|
:a a :actor actor :followed-urls (list) :list-type "following"))
|
||||||
actors)
|
actors)
|
||||||
(when (>= (len actors) 20)
|
(when (>= (len actors) 20)
|
||||||
(~federation-scroll-sentinel
|
(~social/scroll-sentinel
|
||||||
:url (url-for "social.following_list_page" :page 2)))))))
|
:url (url-for "social.following_list_page" :page 2)))))))
|
||||||
|
|
||||||
(defcomp ~federation-followers-content (&key actors total followed-urls actor)
|
(defcomp ~search/followers-content (&key (actors :as list) (total :as number) (followed-urls :as list) actor)
|
||||||
(~federation-actor-list-page
|
(~search/actor-list-page
|
||||||
:title "Followers" :count-str (str "(" total ")")
|
:title "Followers" :count-str (str "(" total ")")
|
||||||
:items (when (not (empty? actors))
|
:items (when (not (empty? actors))
|
||||||
(<>
|
(<>
|
||||||
(map (lambda (a)
|
(map (lambda (a)
|
||||||
(~federation-actor-card-from-data
|
(~search/actor-card-from-data
|
||||||
:a a :actor actor :followed-urls followed-urls :list-type "followers"))
|
:a a :actor actor :followed-urls followed-urls :list-type "followers"))
|
||||||
actors)
|
actors)
|
||||||
(when (>= (len actors) 20)
|
(when (>= (len actors) 20)
|
||||||
(~federation-scroll-sentinel
|
(~social/scroll-sentinel
|
||||||
:url (url-for "social.followers_list_page" :page 2)))))))
|
:url (url-for "social.followers_list_page" :page 2)))))))
|
||||||
|
|||||||
@@ -2,46 +2,46 @@
|
|||||||
|
|
||||||
;; --- Navigation ---
|
;; --- 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"
|
(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")))
|
(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"
|
(a :href href :class cls "Notifications"
|
||||||
(span :sx-get count-url :sx-trigger "load, every 30s" :sx-swap "innerHTML"
|
(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")))
|
: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))
|
(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 :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)))
|
(div :class "w-full flex flex-row items-center gap-2 flex-wrap" nav)))
|
||||||
|
|
||||||
;; --- Post card ---
|
;; --- 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))
|
(div :class "text-sm text-stone-500 mb-2" "Boosted by " name))
|
||||||
|
|
||||||
;; Aliases — delegate to shared ~avatar
|
;; Aliases — delegate to shared ~shared:misc/avatar
|
||||||
(defcomp ~federation-avatar-img (&key src cls)
|
(defcomp ~social/avatar-img (&key (src :as string) (cls :as string))
|
||||||
(~avatar :src src :cls cls))
|
(~shared:misc/avatar :src src :cls cls))
|
||||||
|
|
||||||
(defcomp ~federation-avatar-placeholder (&key cls initial)
|
(defcomp ~social/avatar-placeholder (&key (cls :as string) (initial :as string))
|
||||||
(~avatar :cls cls :initial initial))
|
(~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
|
(if summary
|
||||||
(details :class "mt-2"
|
(details :class "mt-2"
|
||||||
(summary :class "text-stone-500 cursor-pointer" "CW: " (~rich-text :html summary))
|
(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)))
|
||||||
(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"
|
(a :href url :target "_blank" :rel "noopener"
|
||||||
:class "text-sm text-stone-400 hover:underline mt-1 inline-block" "original"))
|
: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"
|
(article :class "bg-white rounded-lg shadow-sm border border-stone-200 p-4 mb-4"
|
||||||
boost
|
boost
|
||||||
(div :class "flex items-start gap-3"
|
(div :class "flex items-start gap-3"
|
||||||
@@ -55,36 +55,36 @@
|
|||||||
|
|
||||||
;; --- Interaction buttons ---
|
;; --- 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"))
|
(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"
|
(form :sx-post action :sx-target target :sx-swap "innerHTML"
|
||||||
(input :type "hidden" :name "object_id" :value oid)
|
(input :type "hidden" :name "object_id" :value oid)
|
||||||
(input :type "hidden" :name "author_inbox" :value ainbox)
|
(input :type "hidden" :name "author_inbox" :value ainbox)
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||||
(button :type "submit" :class cls (span icon) " " count)))
|
(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"
|
(form :sx-post action :sx-target target :sx-swap "innerHTML"
|
||||||
(input :type "hidden" :name "object_id" :value oid)
|
(input :type "hidden" :name "object_id" :value oid)
|
||||||
(input :type "hidden" :name "author_inbox" :value ainbox)
|
(input :type "hidden" :name "author_inbox" :value ainbox)
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||||
(button :type "submit" :class cls (span "\u21bb") " " count)))
|
(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"
|
(div :class "flex items-center gap-4 mt-3 text-sm text-stone-500"
|
||||||
like boost reply))
|
like boost reply))
|
||||||
|
|
||||||
;; --- Timeline ---
|
;; --- 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"))
|
(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"))
|
(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"
|
(div :class "flex items-center justify-between mb-6"
|
||||||
(h1 :class "text-2xl font-bold" label " Timeline")
|
(h1 :class "text-2xl font-bold" label " Timeline")
|
||||||
compose)
|
compose)
|
||||||
@@ -92,24 +92,24 @@
|
|||||||
|
|
||||||
;; --- Data-driven post card (replaces Python _post_card_sx loop) ---
|
;; --- Data-driven post card (replaces Python _post_card_sx loop) ---
|
||||||
|
|
||||||
(defcomp ~federation-post-card-from-data (&key d has-actor csrf
|
(defcomp ~social/post-card-from-data (&key (d :as dict) (has-actor :as boolean) (csrf :as string)
|
||||||
like-url unlike-url
|
(like-url :as string) (unlike-url :as string)
|
||||||
boost-url unboost-url)
|
(boost-url :as string) (unboost-url :as string))
|
||||||
(let* ((boosted-by (get d "boosted_by"))
|
(let* ((boosted-by (get d "boosted_by"))
|
||||||
(actor-icon (get d "actor_icon"))
|
(actor-icon (get d "actor_icon"))
|
||||||
(actor-name (get d "actor_name"))
|
(actor-name (get d "actor_name"))
|
||||||
(initial (or (get d "initial") "?"))
|
(initial (or (get d "initial") "?"))
|
||||||
(avatar (~avatar
|
(avatar (~shared:misc/avatar
|
||||||
:src actor-icon
|
:src actor-icon
|
||||||
:cls (if actor-icon "w-10 h-10 rounded-full"
|
: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")
|
"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)))
|
: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")
|
(content-sx (if (get d "summary")
|
||||||
(~federation-content :content (get d "content") :summary (get d "summary"))
|
(~social/content :content (get d "content") :summary (get d "summary"))
|
||||||
(~federation-content :content (get d "content"))))
|
(~social/content :content (get d "content"))))
|
||||||
(original (when (get d "original_url")
|
(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"))
|
(safe-id (get d "safe_id"))
|
||||||
(interactions (when has-actor
|
(interactions (when has-actor
|
||||||
(let* ((oid (get d "object_id"))
|
(let* ((oid (get d "object_id"))
|
||||||
@@ -123,16 +123,16 @@
|
|||||||
(b-action (if boosted-me unboost-url boost-url))
|
(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")))
|
(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-url (get d "reply_url"))
|
||||||
(reply (when reply-url (~federation-reply-link :url reply-url)))
|
(reply (when reply-url (~social/reply-link :url reply-url)))
|
||||||
(like-form (~federation-like-form
|
(like-form (~social/like-form
|
||||||
:action l-action :target target :oid oid :ainbox ainbox
|
:action l-action :target target :oid oid :ainbox ainbox
|
||||||
:csrf csrf :cls l-cls :icon l-icon :count (get d "like_count")))
|
: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
|
:action b-action :target target :oid oid :ainbox ainbox
|
||||||
:csrf csrf :cls b-cls :count (get d "boost_count"))))
|
:csrf csrf :cls b-cls :count (get d "boost_count"))))
|
||||||
(div :id (str "interactions-" safe-id)
|
(div :id (str "interactions-" safe-id)
|
||||||
(~federation-interaction-buttons :like like-form :boost boost-form :reply reply))))))
|
(~social/interaction-buttons :like like-form :boost boost-form :reply reply))))))
|
||||||
(~federation-post-card
|
(~social/post-card
|
||||||
:boost boost :avatar avatar
|
:boost boost :avatar avatar
|
||||||
:actor-name actor-name :actor-username (get d "actor_username")
|
:actor-name actor-name :actor-username (get d "actor_username")
|
||||||
:domain (get d "domain") :time (get d "time")
|
:domain (get d "domain") :time (get d "time")
|
||||||
@@ -140,22 +140,22 @@
|
|||||||
:interactions interactions)))
|
:interactions interactions)))
|
||||||
|
|
||||||
;; Data-driven timeline items (replaces Python _timeline_items_sx loop)
|
;; Data-driven timeline items (replaces Python _timeline_items_sx loop)
|
||||||
(defcomp ~federation-timeline-items-from-data (&key items next-url has-actor csrf
|
(defcomp ~social/timeline-items-from-data (&key (items :as list) (next-url :as string?) (has-actor :as boolean) (csrf :as string)
|
||||||
like-url unlike-url boost-url unboost-url)
|
(like-url :as string) (unlike-url :as string) (boost-url :as string) (unboost-url :as string))
|
||||||
(<>
|
(<>
|
||||||
(map (lambda (d)
|
(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))
|
:like-url like-url :unlike-url unlike-url :boost-url boost-url :unboost-url unboost-url))
|
||||||
(or items (list)))
|
(or items (list)))
|
||||||
(when next-url (~federation-scroll-sentinel :url next-url))))
|
(when next-url (~social/scroll-sentinel :url next-url))))
|
||||||
|
|
||||||
;; --- Compose ---
|
;; --- 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)
|
(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)))
|
(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")
|
(h1 :class "text-2xl font-bold mb-6" "Compose")
|
||||||
(form :method "post" :action action :class "space-y-4"
|
(form :method "post" :action action :class "space-y-4"
|
||||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||||
@@ -174,9 +174,9 @@
|
|||||||
;; Assembled social nav — replaces Python _social_nav_sx
|
;; Assembled social nav — replaces Python _social_nav_sx
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcomp ~federation-social-nav (&key actor)
|
(defcomp ~social/nav (&key actor)
|
||||||
(if (not 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))
|
(let* ((rp (request-path))
|
||||||
(links (list
|
(links (list
|
||||||
(dict :endpoint "social.defpage_home_timeline" :label "Timeline")
|
(dict :endpoint "social.defpage_home_timeline" :label "Timeline")
|
||||||
@@ -185,7 +185,7 @@
|
|||||||
(dict :endpoint "social.defpage_following_list" :label "Following")
|
(dict :endpoint "social.defpage_following_list" :label "Following")
|
||||||
(dict :endpoint "social.defpage_followers_list" :label "Followers")
|
(dict :endpoint "social.defpage_followers_list" :label "Followers")
|
||||||
(dict :endpoint "social.defpage_search" :label "Search"))))
|
(dict :endpoint "social.defpage_search" :label "Search"))))
|
||||||
(~federation-nav-bar
|
(~social/nav-bar
|
||||||
:items (<>
|
:items (<>
|
||||||
(map (lambda (lnk)
|
(map (lambda (lnk)
|
||||||
(let* ((href (url-for (get lnk "endpoint")))
|
(let* ((href (url-for (get lnk "endpoint")))
|
||||||
@@ -196,7 +196,7 @@
|
|||||||
links)
|
links)
|
||||||
(let* ((notif-url (url-for "social.defpage_notifications"))
|
(let* ((notif-url (url-for "social.defpage_notifications"))
|
||||||
(notif-bold (if (= rp notif-url) " font-bold" "")))
|
(notif-bold (if (= rp notif-url) " font-bold" "")))
|
||||||
(~federation-nav-notification-link
|
(~social/nav-notification-link
|
||||||
:href notif-url
|
:href notif-url
|
||||||
:cls (str "px-2 py-1 rounded hover:bg-stone-200 relative" notif-bold)
|
:cls (str "px-2 py-1 rounded hover:bg-stone-200 relative" notif-bold)
|
||||||
:count-url (url-for "social.notification_count")))
|
:count-url (url-for "social.notification_count")))
|
||||||
@@ -208,7 +208,7 @@
|
|||||||
;; Assembled post card — replaces Python _post_card_sx
|
;; 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"))
|
(let* ((boosted-by (get item "boosted_by"))
|
||||||
(actor-icon (get item "actor_icon"))
|
(actor-icon (get item "actor_icon"))
|
||||||
(actor-name (or (get item "actor_name") "?"))
|
(actor-name (or (get item "actor_name") "?"))
|
||||||
@@ -223,9 +223,9 @@
|
|||||||
(safe-id (replace (replace oid "/" "_") ":" "_"))
|
(safe-id (replace (replace oid "/" "_") ":" "_"))
|
||||||
(initial (if (and (not actor-icon) actor-name)
|
(initial (if (and (not actor-icon) actor-name)
|
||||||
(upper (slice actor-name 0 1)) "?")))
|
(upper (slice actor-name 0 1)) "?")))
|
||||||
(~federation-post-card
|
(~social/post-card
|
||||||
:boost (when boosted-by (~federation-boost-label :name (escape boosted-by)))
|
:boost (when boosted-by (~social/boost-label :name (escape boosted-by)))
|
||||||
:avatar (~avatar
|
:avatar (~shared:misc/avatar
|
||||||
:src actor-icon
|
:src actor-icon
|
||||||
:cls (if actor-icon "w-10 h-10 rounded-full"
|
: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")
|
"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)) "")
|
:domain (if actor-domain (str "@" (escape actor-domain)) "")
|
||||||
:time published
|
:time published
|
||||||
:content (if summary
|
:content (if summary
|
||||||
(~federation-content :content content :summary (escape summary))
|
(~social/content :content content :summary (escape summary))
|
||||||
(~federation-content :content content))
|
(~social/content :content content))
|
||||||
:original (when (and url (= post-type "remote"))
|
:original (when (and url (= post-type "remote"))
|
||||||
(~federation-original-link :url url))
|
(~social/original-link :url url))
|
||||||
:interactions (when actor
|
:interactions (when actor
|
||||||
(let* ((csrf (csrf-token))
|
(let* ((csrf (csrf-token))
|
||||||
(liked (get item "liked_by_me"))
|
(liked (get item "liked_by_me"))
|
||||||
@@ -248,50 +248,50 @@
|
|||||||
(ainbox (or (get item "author_inbox") ""))
|
(ainbox (or (get item "author_inbox") ""))
|
||||||
(target (str "#interactions-" safe-id)))
|
(target (str "#interactions-" safe-id)))
|
||||||
(div :id (str "interactions-" safe-id)
|
(div :id (str "interactions-" safe-id)
|
||||||
(~federation-interaction-buttons
|
(~social/interaction-buttons
|
||||||
:like (~federation-like-form
|
:like (~social/like-form
|
||||||
:action (url-for (if liked "social.unlike" "social.like"))
|
:action (url-for (if liked "social.unlike" "social.like"))
|
||||||
:target target :oid oid :ainbox ainbox :csrf csrf
|
: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"))
|
: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))
|
: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"))
|
:action (url-for (if boosted-me "social.unboost" "social.boost"))
|
||||||
:target target :oid oid :ainbox ainbox :csrf csrf
|
: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"))
|
:cls (str "flex items-center gap-1 " (if boosted-me "text-green-600 hover:text-green-700" "hover:text-green-600"))
|
||||||
:count (str bcount))
|
:count (str bcount))
|
||||||
:reply (when oid
|
:reply (when oid
|
||||||
(~federation-reply-link
|
(~social/reply-link
|
||||||
:url (url-for "social.defpage_compose_form" :reply-to oid))))))))))
|
:url (url-for "social.defpage_compose_form" :reply-to oid))))))))))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Assembled timeline items — replaces Python _timeline_items_sx
|
;; 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)
|
(map (lambda (item)
|
||||||
(~federation-post-card-from-data :item item :actor actor))
|
(~social/post-card-from-data :item item :actor actor))
|
||||||
items)
|
items)
|
||||||
(when next-url
|
(when next-url
|
||||||
(~federation-scroll-sentinel :url next-url))))
|
(~social/scroll-sentinel :url next-url))))
|
||||||
|
|
||||||
;; Assembled timeline content — replaces Python _timeline_content_sx
|
;; 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")))
|
(let* ((label (if (= timeline-type "home") "Home" "Public")))
|
||||||
(~federation-timeline-page
|
(~social/timeline-page
|
||||||
:label label
|
:label label
|
||||||
:compose (when actor
|
:compose (when actor
|
||||||
(~federation-compose-button :url (url-for "social.defpage_compose_form")))
|
(~social/compose-button :url (url-for "social.defpage_compose_form")))
|
||||||
:timeline (~federation-timeline-items
|
:timeline (~social/timeline-items
|
||||||
:items items :timeline-type timeline-type :actor actor
|
:items items :timeline-type timeline-type :actor actor
|
||||||
:next-url (when (not (empty? items))
|
:next-url (when (not (empty? items))
|
||||||
(url-for (str "social." timeline-type "_timeline_page")
|
(url-for (str "social." timeline-type "_timeline_page")
|
||||||
:before (get (last items) "before_cursor")))))))
|
:before (get (last items) "before_cursor")))))))
|
||||||
|
|
||||||
;; Assembled compose content — replaces Python _compose_content_sx
|
;; Assembled compose content — replaces Python _compose_content_sx
|
||||||
(defcomp ~federation-compose-content (&key reply-to)
|
(defcomp ~social/compose-content (&key (reply-to :as string?))
|
||||||
(~federation-compose-form
|
(~social/compose-form
|
||||||
:action (url-for "social.compose_submit")
|
:action (url-for "social.compose_submit")
|
||||||
:csrf (csrf-token)
|
:csrf (csrf-token)
|
||||||
:reply (when reply-to
|
: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
|
:auth :login
|
||||||
:layout :social
|
:layout :social
|
||||||
:data (service "federation-page" "home-timeline-data")
|
:data (service "federation-page" "home-timeline-data")
|
||||||
:content (~federation-timeline-content
|
:content (~social/timeline-content
|
||||||
:items items
|
:items items
|
||||||
:timeline-type timeline-type
|
:timeline-type timeline-type
|
||||||
:actor actor))
|
:actor actor))
|
||||||
@@ -16,7 +16,7 @@
|
|||||||
:auth :public
|
:auth :public
|
||||||
:layout :social
|
:layout :social
|
||||||
:data (service "federation-page" "public-timeline-data")
|
:data (service "federation-page" "public-timeline-data")
|
||||||
:content (~federation-timeline-content
|
:content (~social/timeline-content
|
||||||
:items items
|
:items items
|
||||||
:timeline-type timeline-type
|
:timeline-type timeline-type
|
||||||
:actor actor))
|
:actor actor))
|
||||||
@@ -26,7 +26,7 @@
|
|||||||
:auth :login
|
:auth :login
|
||||||
:layout :social
|
:layout :social
|
||||||
:data (service "federation-page" "compose-data")
|
:data (service "federation-page" "compose-data")
|
||||||
:content (~federation-compose-content
|
:content (~social/compose-content
|
||||||
:reply-to reply-to))
|
:reply-to reply-to))
|
||||||
|
|
||||||
(defpage search
|
(defpage search
|
||||||
@@ -34,7 +34,7 @@
|
|||||||
:auth :public
|
:auth :public
|
||||||
:layout :social
|
:layout :social
|
||||||
:data (service "federation-page" "search-data")
|
:data (service "federation-page" "search-data")
|
||||||
:content (~federation-search-content
|
:content (~search/content
|
||||||
:query query
|
:query query
|
||||||
:actors actors
|
:actors actors
|
||||||
:total total
|
:total total
|
||||||
@@ -46,7 +46,7 @@
|
|||||||
:auth :login
|
:auth :login
|
||||||
:layout :social
|
:layout :social
|
||||||
:data (service "federation-page" "following-data")
|
:data (service "federation-page" "following-data")
|
||||||
:content (~federation-following-content
|
:content (~search/following-content
|
||||||
:actors actors
|
:actors actors
|
||||||
:total total
|
:total total
|
||||||
:actor actor))
|
:actor actor))
|
||||||
@@ -56,7 +56,7 @@
|
|||||||
:auth :login
|
:auth :login
|
||||||
:layout :social
|
:layout :social
|
||||||
:data (service "federation-page" "followers-data")
|
:data (service "federation-page" "followers-data")
|
||||||
:content (~federation-followers-content
|
:content (~search/followers-content
|
||||||
:actors actors
|
:actors actors
|
||||||
:total total
|
:total total
|
||||||
:followed-urls followed-urls
|
:followed-urls followed-urls
|
||||||
@@ -67,7 +67,7 @@
|
|||||||
:auth :public
|
:auth :public
|
||||||
:layout :social
|
:layout :social
|
||||||
:data (service "federation-page" "actor-timeline-data" :id id)
|
:data (service "federation-page" "actor-timeline-data" :id id)
|
||||||
:content (~federation-actor-timeline-content
|
:content (~profile/actor-timeline-content
|
||||||
:remote-actor remote-actor
|
:remote-actor remote-actor
|
||||||
:items items
|
:items items
|
||||||
:is-following is-following
|
:is-following is-following
|
||||||
@@ -78,5 +78,5 @@
|
|||||||
:auth :login
|
:auth :login
|
||||||
:layout :social
|
:layout :social
|
||||||
:data (service "federation-page" "notifications-data")
|
:data (service "federation-page" "notifications-data")
|
||||||
:content (~federation-notifications-content
|
:content (~notifications/content
|
||||||
:notifications notifications))
|
:notifications notifications))
|
||||||
|
|||||||
@@ -27,7 +27,7 @@ async def _social_page(ctx: dict, actor, *, content: str,
|
|||||||
from markupsafe import escape
|
from markupsafe import escape
|
||||||
|
|
||||||
env = {"actor": _serialize_actor(actor) if actor else None}
|
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,
|
return await full_page_sx(ctx, header_rows=header_rows, content=content,
|
||||||
meta_html=meta_html or f'<title>{escape(title)}</title>')
|
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)
|
||||||
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
457
hosts/ocaml/lib/sx_render.ml
Normal file
457
hosts/ocaml/lib/sx_render.ml
Normal file
@@ -0,0 +1,457 @@
|
|||||||
|
(** HTML renderer for SX values.
|
||||||
|
|
||||||
|
Extracted from run_tests.ml — renders an SX expression tree to an
|
||||||
|
HTML string, expanding components and macros along the way.
|
||||||
|
|
||||||
|
Depends on [Sx_ref.eval_expr] for evaluating sub-expressions
|
||||||
|
during rendering (keyword arg values, conditionals, etc.). *)
|
||||||
|
|
||||||
|
open Sx_types
|
||||||
|
|
||||||
|
(* ====================================================================== *)
|
||||||
|
(* Tag / attribute registries *)
|
||||||
|
(* ====================================================================== *)
|
||||||
|
|
||||||
|
let html_tags = [
|
||||||
|
"html"; "head"; "body"; "title"; "meta"; "link"; "script"; "style"; "noscript";
|
||||||
|
"header"; "nav"; "main"; "section"; "article"; "aside"; "footer";
|
||||||
|
"h1"; "h2"; "h3"; "h4"; "h5"; "h6"; "hgroup";
|
||||||
|
"div"; "p"; "blockquote"; "pre"; "figure"; "figcaption"; "address"; "hr";
|
||||||
|
"ul"; "ol"; "li"; "dl"; "dt"; "dd"; "menu";
|
||||||
|
"a"; "span"; "em"; "strong"; "small"; "b"; "i"; "u"; "s"; "sub"; "sup";
|
||||||
|
"mark"; "del"; "ins"; "q"; "cite"; "dfn"; "abbr"; "code"; "var"; "samp";
|
||||||
|
"kbd"; "data"; "time"; "ruby"; "rt"; "rp"; "bdi"; "bdo"; "wbr"; "br";
|
||||||
|
"table"; "thead"; "tbody"; "tfoot"; "tr"; "th"; "td"; "caption"; "colgroup"; "col";
|
||||||
|
"form"; "input"; "textarea"; "select"; "option"; "optgroup"; "button"; "label";
|
||||||
|
"fieldset"; "legend"; "datalist"; "output"; "progress"; "meter";
|
||||||
|
"details"; "summary"; "dialog";
|
||||||
|
"img"; "video"; "audio"; "source"; "picture"; "canvas"; "iframe"; "embed"; "object"; "param";
|
||||||
|
"svg"; "path"; "circle"; "rect"; "line"; "polyline"; "polygon"; "ellipse";
|
||||||
|
"g"; "defs"; "use"; "text"; "tspan"; "clipPath"; "mask"; "pattern";
|
||||||
|
"linearGradient"; "radialGradient"; "stop"; "filter"; "feBlend"; "feFlood";
|
||||||
|
"feGaussianBlur"; "feOffset"; "feMerge"; "feMergeNode"; "feComposite";
|
||||||
|
"template"; "slot";
|
||||||
|
]
|
||||||
|
|
||||||
|
let void_elements = [
|
||||||
|
"area"; "base"; "br"; "col"; "embed"; "hr"; "img"; "input";
|
||||||
|
"link"; "meta"; "param"; "source"; "track"; "wbr"
|
||||||
|
]
|
||||||
|
|
||||||
|
let boolean_attrs = [
|
||||||
|
"async"; "autofocus"; "autoplay"; "checked"; "controls"; "default";
|
||||||
|
"defer"; "disabled"; "formnovalidate"; "hidden"; "inert"; "ismap";
|
||||||
|
"loop"; "multiple"; "muted"; "nomodule"; "novalidate"; "open";
|
||||||
|
"playsinline"; "readonly"; "required"; "reversed"; "selected"
|
||||||
|
]
|
||||||
|
|
||||||
|
let is_html_tag name = List.mem name html_tags
|
||||||
|
let is_void name = List.mem name void_elements
|
||||||
|
let is_boolean_attr name = List.mem name boolean_attrs
|
||||||
|
|
||||||
|
|
||||||
|
(* ====================================================================== *)
|
||||||
|
(* HTML escaping *)
|
||||||
|
(* ====================================================================== *)
|
||||||
|
|
||||||
|
let escape_html s =
|
||||||
|
let buf = Buffer.create (String.length s) in
|
||||||
|
String.iter (function
|
||||||
|
| '&' -> Buffer.add_string buf "&"
|
||||||
|
| '<' -> Buffer.add_string buf "<"
|
||||||
|
| '>' -> Buffer.add_string buf ">"
|
||||||
|
| '"' -> Buffer.add_string buf """
|
||||||
|
| c -> Buffer.add_char buf c) s;
|
||||||
|
Buffer.contents buf
|
||||||
|
|
||||||
|
|
||||||
|
(* ====================================================================== *)
|
||||||
|
(* Attribute rendering *)
|
||||||
|
(* ====================================================================== *)
|
||||||
|
|
||||||
|
let render_attrs attrs =
|
||||||
|
let buf = Buffer.create 64 in
|
||||||
|
Hashtbl.iter (fun k v ->
|
||||||
|
if is_boolean_attr k then begin
|
||||||
|
if sx_truthy v then begin
|
||||||
|
Buffer.add_char buf ' ';
|
||||||
|
Buffer.add_string buf k
|
||||||
|
end
|
||||||
|
end else if not (is_nil v) then begin
|
||||||
|
Buffer.add_char buf ' ';
|
||||||
|
Buffer.add_string buf k;
|
||||||
|
Buffer.add_string buf "=\"";
|
||||||
|
Buffer.add_string buf (escape_html (value_to_string v));
|
||||||
|
Buffer.add_char buf '"'
|
||||||
|
end) attrs;
|
||||||
|
Buffer.contents buf
|
||||||
|
|
||||||
|
|
||||||
|
(* ====================================================================== *)
|
||||||
|
(* HTML renderer *)
|
||||||
|
(* ====================================================================== *)
|
||||||
|
|
||||||
|
(* Forward ref — resolved at setup time *)
|
||||||
|
let render_to_html_ref : (value -> env -> string) ref =
|
||||||
|
ref (fun _expr _env -> "")
|
||||||
|
|
||||||
|
let render_to_html expr env = !render_to_html_ref expr env
|
||||||
|
|
||||||
|
let render_children children env =
|
||||||
|
String.concat "" (List.map (fun c -> render_to_html c env) children)
|
||||||
|
|
||||||
|
(** Parse keyword attrs and positional children from an element call's args.
|
||||||
|
Attrs are evaluated; children are returned UNEVALUATED for render dispatch. *)
|
||||||
|
let parse_element_args args env =
|
||||||
|
let attrs = Hashtbl.create 8 in
|
||||||
|
let children = ref [] in
|
||||||
|
let skip = ref false in
|
||||||
|
let len = List.length args in
|
||||||
|
List.iteri (fun idx arg ->
|
||||||
|
if !skip then skip := false
|
||||||
|
else match arg with
|
||||||
|
| Keyword k when idx + 1 < len ->
|
||||||
|
let v = Sx_ref.eval_expr (List.nth args (idx + 1)) (Env env) in
|
||||||
|
Hashtbl.replace attrs k v;
|
||||||
|
skip := true
|
||||||
|
| Spread pairs ->
|
||||||
|
List.iter (fun (k, v) -> Hashtbl.replace attrs k v) pairs
|
||||||
|
| _ ->
|
||||||
|
children := arg :: !children
|
||||||
|
) args;
|
||||||
|
(attrs, List.rev !children)
|
||||||
|
|
||||||
|
let render_html_element tag args env =
|
||||||
|
let (attrs, children) = parse_element_args args env in
|
||||||
|
let attr_str = render_attrs attrs in
|
||||||
|
if is_void tag then
|
||||||
|
"<" ^ tag ^ attr_str ^ " />"
|
||||||
|
else
|
||||||
|
let content = String.concat ""
|
||||||
|
(List.map (fun c -> render_to_html c env) children) in
|
||||||
|
"<" ^ tag ^ attr_str ^ ">" ^ content ^ "</" ^ tag ^ ">"
|
||||||
|
|
||||||
|
let render_component comp args env =
|
||||||
|
match comp with
|
||||||
|
| Component c ->
|
||||||
|
let kwargs = Hashtbl.create 8 in
|
||||||
|
let children_exprs = ref [] in
|
||||||
|
let skip = ref false in
|
||||||
|
let len = List.length args in
|
||||||
|
List.iteri (fun idx arg ->
|
||||||
|
if !skip then skip := false
|
||||||
|
else match arg with
|
||||||
|
| Keyword k when idx + 1 < len ->
|
||||||
|
let v = Sx_ref.eval_expr (List.nth args (idx + 1)) (Env env) in
|
||||||
|
Hashtbl.replace kwargs k v;
|
||||||
|
skip := true
|
||||||
|
| _ ->
|
||||||
|
children_exprs := arg :: !children_exprs
|
||||||
|
) args;
|
||||||
|
let children = List.rev !children_exprs in
|
||||||
|
let local = env_merge c.c_closure env in
|
||||||
|
List.iter (fun p ->
|
||||||
|
let v = match Hashtbl.find_opt kwargs p with Some v -> v | None -> Nil in
|
||||||
|
ignore (env_bind local p v)
|
||||||
|
) c.c_params;
|
||||||
|
if c.c_has_children then begin
|
||||||
|
let rendered_children = String.concat ""
|
||||||
|
(List.map (fun c -> render_to_html c env) children) in
|
||||||
|
ignore (env_bind local "children" (RawHTML rendered_children))
|
||||||
|
end;
|
||||||
|
render_to_html c.c_body local
|
||||||
|
| _ -> ""
|
||||||
|
|
||||||
|
let expand_macro (m : macro) args _env =
|
||||||
|
let local = env_extend m.m_closure in
|
||||||
|
let params = m.m_params in
|
||||||
|
let rec bind_params ps as' =
|
||||||
|
match ps, as' with
|
||||||
|
| [], rest ->
|
||||||
|
(match m.m_rest_param with
|
||||||
|
| Some rp -> ignore (env_bind local rp (List rest))
|
||||||
|
| None -> ())
|
||||||
|
| p :: ps_rest, a :: as_rest ->
|
||||||
|
ignore (env_bind local p a);
|
||||||
|
bind_params ps_rest as_rest
|
||||||
|
| _ :: _, [] ->
|
||||||
|
List.iter (fun p -> ignore (env_bind local p Nil)) (List.rev ps)
|
||||||
|
in
|
||||||
|
bind_params params args;
|
||||||
|
Sx_ref.eval_expr m.m_body (Env local)
|
||||||
|
|
||||||
|
let rec do_render_to_html (expr : value) (env : env) : string =
|
||||||
|
match expr with
|
||||||
|
| Nil -> ""
|
||||||
|
| Bool true -> "true"
|
||||||
|
| Bool false -> "false"
|
||||||
|
| Number n ->
|
||||||
|
if Float.is_integer n then string_of_int (int_of_float n)
|
||||||
|
else Printf.sprintf "%g" n
|
||||||
|
| String s -> escape_html s
|
||||||
|
| Keyword k -> escape_html k
|
||||||
|
| RawHTML s -> s
|
||||||
|
| Symbol s ->
|
||||||
|
let v = Sx_ref.eval_expr (Symbol s) (Env env) in
|
||||||
|
do_render_to_html v env
|
||||||
|
| List [] | ListRef { contents = [] } -> ""
|
||||||
|
| List (head :: args) | ListRef { contents = head :: args } ->
|
||||||
|
render_list_to_html head args env
|
||||||
|
| _ ->
|
||||||
|
let v = Sx_ref.eval_expr expr (Env env) in
|
||||||
|
do_render_to_html v env
|
||||||
|
|
||||||
|
and render_list_to_html head args env =
|
||||||
|
match head with
|
||||||
|
| Symbol "<>" ->
|
||||||
|
render_children args env
|
||||||
|
| Symbol "raw!" ->
|
||||||
|
(* Inject pre-rendered HTML without escaping *)
|
||||||
|
let v = Sx_ref.eval_expr (List.hd args) (Env env) in
|
||||||
|
(match v with
|
||||||
|
| String s | RawHTML s -> s
|
||||||
|
| _ -> value_to_string v)
|
||||||
|
| Symbol tag when is_html_tag tag ->
|
||||||
|
render_html_element tag args env
|
||||||
|
| Symbol "if" ->
|
||||||
|
let cond_val = Sx_ref.eval_expr (List.hd args) (Env env) in
|
||||||
|
if sx_truthy cond_val then
|
||||||
|
(if List.length args > 1 then do_render_to_html (List.nth args 1) env else "")
|
||||||
|
else
|
||||||
|
(if List.length args > 2 then do_render_to_html (List.nth args 2) env else "")
|
||||||
|
| Symbol "when" ->
|
||||||
|
let cond_val = Sx_ref.eval_expr (List.hd args) (Env env) in
|
||||||
|
if sx_truthy cond_val then
|
||||||
|
String.concat "" (List.map (fun e -> do_render_to_html e env) (List.tl args))
|
||||||
|
else ""
|
||||||
|
| Symbol "cond" ->
|
||||||
|
render_cond args env
|
||||||
|
| Symbol "case" ->
|
||||||
|
let v = Sx_ref.eval_expr (List (head :: args)) (Env env) in
|
||||||
|
do_render_to_html v env
|
||||||
|
| Symbol ("let" | "let*") ->
|
||||||
|
render_let args env
|
||||||
|
| Symbol ("begin" | "do") ->
|
||||||
|
let rec go = function
|
||||||
|
| [] -> ""
|
||||||
|
| [last] -> do_render_to_html last env
|
||||||
|
| e :: rest ->
|
||||||
|
ignore (Sx_ref.eval_expr e (Env env));
|
||||||
|
go rest
|
||||||
|
in go args
|
||||||
|
| Symbol ("define" | "defcomp" | "defmacro" | "defisland") ->
|
||||||
|
ignore (Sx_ref.eval_expr (List (head :: args)) (Env env));
|
||||||
|
""
|
||||||
|
| Symbol "map" ->
|
||||||
|
render_map args env false
|
||||||
|
| Symbol "map-indexed" ->
|
||||||
|
render_map args env true
|
||||||
|
| Symbol "filter" ->
|
||||||
|
let v = Sx_ref.eval_expr (List (head :: args)) (Env env) in
|
||||||
|
do_render_to_html v env
|
||||||
|
| Symbol "for-each" ->
|
||||||
|
render_for_each args env
|
||||||
|
| Symbol name ->
|
||||||
|
(try
|
||||||
|
let v = env_get env name in
|
||||||
|
(match v with
|
||||||
|
| Component c when c.c_affinity = "client" -> "" (* skip client-only *)
|
||||||
|
| Component _ -> render_component v args env
|
||||||
|
| Island _i ->
|
||||||
|
(* Islands: SSR via the SX render-to-html from adapter-html.sx.
|
||||||
|
It handles deref/signal/computed through the CEK correctly,
|
||||||
|
and renders island bodies with hydration markers. *)
|
||||||
|
(try
|
||||||
|
let call_expr = List (Symbol name :: args) in
|
||||||
|
let quoted = List [Symbol "quote"; call_expr] in
|
||||||
|
let render_call = List [Symbol "render-to-html"; quoted; Env env] in
|
||||||
|
let result = Sx_ref.eval_expr render_call (Env env) in
|
||||||
|
(match result with
|
||||||
|
| String s | RawHTML s -> s
|
||||||
|
| _ -> value_to_string result)
|
||||||
|
with e ->
|
||||||
|
Printf.eprintf "[ssr-island] ~%s FAILED: %s\n%s\n%!" _i.i_name (Printexc.to_string e) (Printexc.get_backtrace ());
|
||||||
|
"")
|
||||||
|
| Macro m ->
|
||||||
|
let expanded = expand_macro m args env in
|
||||||
|
do_render_to_html expanded env
|
||||||
|
| _ ->
|
||||||
|
let result = Sx_ref.eval_expr (List (head :: args)) (Env env) in
|
||||||
|
do_render_to_html result env)
|
||||||
|
with Eval_error _ ->
|
||||||
|
let result = Sx_ref.eval_expr (List (head :: args)) (Env env) in
|
||||||
|
do_render_to_html result env)
|
||||||
|
| _ ->
|
||||||
|
let result = Sx_ref.eval_expr (List (head :: args)) (Env env) in
|
||||||
|
do_render_to_html result env
|
||||||
|
|
||||||
|
and render_cond args env =
|
||||||
|
let as_list = function List l | ListRef { contents = l } -> Some l | _ -> None in
|
||||||
|
let is_scheme = List.for_all (fun a -> match as_list a with
|
||||||
|
| Some items when List.length items = 2 -> true
|
||||||
|
| _ -> false) args
|
||||||
|
in
|
||||||
|
if is_scheme then begin
|
||||||
|
let rec go = function
|
||||||
|
| [] -> ""
|
||||||
|
| clause :: rest ->
|
||||||
|
(match as_list clause with
|
||||||
|
| Some [test; body] ->
|
||||||
|
let is_else = match test with
|
||||||
|
| Keyword "else" -> true
|
||||||
|
| Symbol "else" | Symbol ":else" -> true
|
||||||
|
| _ -> false
|
||||||
|
in
|
||||||
|
if is_else then do_render_to_html body env
|
||||||
|
else
|
||||||
|
let v = Sx_ref.eval_expr test (Env env) in
|
||||||
|
if sx_truthy v then do_render_to_html body env
|
||||||
|
else go rest
|
||||||
|
| _ -> "")
|
||||||
|
in go args
|
||||||
|
end else begin
|
||||||
|
let rec go = function
|
||||||
|
| [] -> ""
|
||||||
|
| [_] -> ""
|
||||||
|
| test :: body :: rest ->
|
||||||
|
let is_else = match test with
|
||||||
|
| Keyword "else" -> true
|
||||||
|
| Symbol "else" | Symbol ":else" -> true
|
||||||
|
| _ -> false
|
||||||
|
in
|
||||||
|
if is_else then do_render_to_html body env
|
||||||
|
else
|
||||||
|
let v = Sx_ref.eval_expr test (Env env) in
|
||||||
|
if sx_truthy v then do_render_to_html body env
|
||||||
|
else go rest
|
||||||
|
in go args
|
||||||
|
end
|
||||||
|
|
||||||
|
and render_let args env =
|
||||||
|
let as_list = function List l | ListRef { contents = l } -> Some l | _ -> None in
|
||||||
|
let bindings_expr = List.hd args in
|
||||||
|
let body = List.tl args in
|
||||||
|
let local = env_extend env in
|
||||||
|
let bindings = match as_list bindings_expr with Some l -> l | None -> [] in
|
||||||
|
let is_scheme = match bindings with
|
||||||
|
| (List _ :: _) | (ListRef _ :: _) -> true
|
||||||
|
| _ -> false
|
||||||
|
in
|
||||||
|
if is_scheme then
|
||||||
|
List.iter (fun b ->
|
||||||
|
match as_list b with
|
||||||
|
| Some [Symbol name; expr] | Some [String name; expr] ->
|
||||||
|
let v = Sx_ref.eval_expr expr (Env local) in
|
||||||
|
ignore (env_bind local name v)
|
||||||
|
| _ -> ()
|
||||||
|
) bindings
|
||||||
|
else begin
|
||||||
|
let rec go = function
|
||||||
|
| [] -> ()
|
||||||
|
| (Symbol name) :: expr :: rest | (String name) :: expr :: rest ->
|
||||||
|
let v = Sx_ref.eval_expr expr (Env local) in
|
||||||
|
ignore (env_bind local name v);
|
||||||
|
go rest
|
||||||
|
| _ -> ()
|
||||||
|
in go bindings
|
||||||
|
end;
|
||||||
|
let rec render_body = function
|
||||||
|
| [] -> ""
|
||||||
|
| [last] -> do_render_to_html last local
|
||||||
|
| e :: rest ->
|
||||||
|
ignore (Sx_ref.eval_expr e (Env local));
|
||||||
|
render_body rest
|
||||||
|
in render_body body
|
||||||
|
|
||||||
|
and render_map args env indexed =
|
||||||
|
let (fn_val, coll_val) = match args with
|
||||||
|
| [a; b] ->
|
||||||
|
let va = Sx_ref.eval_expr a (Env env) in
|
||||||
|
let vb = Sx_ref.eval_expr b (Env env) in
|
||||||
|
(match va, vb with
|
||||||
|
| (Lambda _ | NativeFn _), _ -> (va, vb)
|
||||||
|
| _, (Lambda _ | NativeFn _) -> (vb, va)
|
||||||
|
| _ -> (va, vb))
|
||||||
|
| _ -> (Nil, Nil)
|
||||||
|
in
|
||||||
|
let items = match coll_val with List l | ListRef { contents = l } -> l | _ -> [] in
|
||||||
|
String.concat "" (List.mapi (fun i item ->
|
||||||
|
let call_args = if indexed then [Number (float_of_int i); item] else [item] in
|
||||||
|
match fn_val with
|
||||||
|
| Lambda l ->
|
||||||
|
let local = env_extend l.l_closure in
|
||||||
|
List.iter2 (fun p a -> ignore (env_bind local p a))
|
||||||
|
l.l_params call_args;
|
||||||
|
do_render_to_html l.l_body local
|
||||||
|
| _ ->
|
||||||
|
let result = Sx_runtime.sx_call fn_val call_args in
|
||||||
|
do_render_to_html result env
|
||||||
|
) items)
|
||||||
|
|
||||||
|
and render_for_each args env =
|
||||||
|
let (fn_val, coll_val) = match args with
|
||||||
|
| [a; b] ->
|
||||||
|
let va = Sx_ref.eval_expr a (Env env) in
|
||||||
|
let vb = Sx_ref.eval_expr b (Env env) in
|
||||||
|
(match va, vb with
|
||||||
|
| (Lambda _ | NativeFn _), _ -> (va, vb)
|
||||||
|
| _, (Lambda _ | NativeFn _) -> (vb, va)
|
||||||
|
| _ -> (va, vb))
|
||||||
|
| _ -> (Nil, Nil)
|
||||||
|
in
|
||||||
|
let items = match coll_val with List l | ListRef { contents = l } -> l | _ -> [] in
|
||||||
|
String.concat "" (List.map (fun item ->
|
||||||
|
match fn_val with
|
||||||
|
| Lambda l ->
|
||||||
|
let local = env_extend l.l_closure in
|
||||||
|
List.iter2 (fun p a -> ignore (env_bind local p a))
|
||||||
|
l.l_params [item];
|
||||||
|
do_render_to_html l.l_body local
|
||||||
|
| _ ->
|
||||||
|
let result = Sx_runtime.sx_call fn_val [item] in
|
||||||
|
do_render_to_html result env
|
||||||
|
) items)
|
||||||
|
|
||||||
|
|
||||||
|
(* ====================================================================== *)
|
||||||
|
(* Setup — bind render primitives in an env and wire up the ref *)
|
||||||
|
(* ====================================================================== *)
|
||||||
|
|
||||||
|
let setup_render_env env =
|
||||||
|
render_to_html_ref := do_render_to_html;
|
||||||
|
|
||||||
|
let bind name fn =
|
||||||
|
ignore (env_bind env name (NativeFn (name, fn)))
|
||||||
|
in
|
||||||
|
|
||||||
|
bind "render-html" (fun args ->
|
||||||
|
match args with
|
||||||
|
| [String src] ->
|
||||||
|
let exprs = Sx_parser.parse_all src in
|
||||||
|
let expr = match exprs with
|
||||||
|
| [e] -> e
|
||||||
|
| [] -> Nil
|
||||||
|
| _ -> List (Symbol "do" :: exprs)
|
||||||
|
in
|
||||||
|
String (render_to_html expr env)
|
||||||
|
| [expr] ->
|
||||||
|
String (render_to_html expr env)
|
||||||
|
| [expr; Env e] ->
|
||||||
|
String (render_to_html expr e)
|
||||||
|
| _ -> String "");
|
||||||
|
|
||||||
|
bind "render-to-html" (fun args ->
|
||||||
|
match args with
|
||||||
|
| [String src] ->
|
||||||
|
let exprs = Sx_parser.parse_all src in
|
||||||
|
let expr = match exprs with
|
||||||
|
| [e] -> e
|
||||||
|
| [] -> Nil
|
||||||
|
| _ -> List (Symbol "do" :: exprs)
|
||||||
|
in
|
||||||
|
String (render_to_html expr env)
|
||||||
|
| [expr] ->
|
||||||
|
String (render_to_html expr env)
|
||||||
|
| [expr; Env e] ->
|
||||||
|
String (render_to_html expr e)
|
||||||
|
| _ -> String "")
|
||||||
419
hosts/ocaml/lib/sx_runtime.ml
Normal file
419
hosts/ocaml/lib/sx_runtime.ml
Normal file
@@ -0,0 +1,419 @@
|
|||||||
|
(** Runtime helpers for transpiled code.
|
||||||
|
|
||||||
|
These bridge the gap between the transpiler's output and the
|
||||||
|
foundation types/primitives. The transpiled evaluator calls these
|
||||||
|
functions directly. *)
|
||||||
|
|
||||||
|
open Sx_types
|
||||||
|
|
||||||
|
(** Call a registered primitive by name. *)
|
||||||
|
let prim_call name args =
|
||||||
|
match Hashtbl.find_opt Sx_primitives.primitives name with
|
||||||
|
| Some f -> f args
|
||||||
|
| None -> raise (Eval_error ("Unknown primitive: " ^ name))
|
||||||
|
|
||||||
|
(** Convert any SX value to an OCaml string (internal). *)
|
||||||
|
let value_to_str = function
|
||||||
|
| String s -> s
|
||||||
|
| Number n ->
|
||||||
|
if Float.is_integer n then string_of_int (int_of_float n)
|
||||||
|
else Printf.sprintf "%g" n
|
||||||
|
| Bool true -> "true"
|
||||||
|
| Bool false -> "false"
|
||||||
|
| Nil -> ""
|
||||||
|
| Symbol s -> s
|
||||||
|
| Keyword k -> k
|
||||||
|
| v -> inspect v
|
||||||
|
|
||||||
|
(** sx_to_string returns a value (String) for transpiled code. *)
|
||||||
|
let sx_to_string v = String (value_to_str v)
|
||||||
|
|
||||||
|
(** String concatenation helper — [sx_str] takes a list of values. *)
|
||||||
|
let sx_str args =
|
||||||
|
String.concat "" (List.map value_to_str args)
|
||||||
|
|
||||||
|
(** Convert a value to a list. *)
|
||||||
|
let sx_to_list = function
|
||||||
|
| List l -> l
|
||||||
|
| ListRef r -> !r
|
||||||
|
| Nil -> []
|
||||||
|
| v -> raise (Eval_error ("Expected list, got " ^ type_of v))
|
||||||
|
|
||||||
|
(** Call an SX callable (lambda, native fn, continuation). *)
|
||||||
|
let sx_call f args =
|
||||||
|
match f with
|
||||||
|
| NativeFn (_, fn) -> fn args
|
||||||
|
| VmClosure cl -> !Sx_types._vm_call_closure_ref cl args
|
||||||
|
| Lambda l ->
|
||||||
|
let local = Sx_types.env_extend l.l_closure in
|
||||||
|
List.iter2 (fun p a -> ignore (Sx_types.env_bind local p a)) l.l_params args;
|
||||||
|
Thunk (l.l_body, local)
|
||||||
|
| Continuation (k, _) ->
|
||||||
|
k (match args with x :: _ -> x | [] -> Nil)
|
||||||
|
| _ -> raise (Eval_error ("Not callable: " ^ inspect f))
|
||||||
|
|
||||||
|
(* Initialize forward ref so primitives can call SX functions *)
|
||||||
|
let () = Sx_primitives._sx_call_fn := sx_call
|
||||||
|
(* Trampoline ref is set by sx_ref.ml after it's loaded *)
|
||||||
|
|
||||||
|
(** Apply a function to a list of args. *)
|
||||||
|
let sx_apply f args_list =
|
||||||
|
sx_call f (sx_to_list args_list)
|
||||||
|
|
||||||
|
(** Mutable append — add item to a list ref or accumulator.
|
||||||
|
In transpiled code, lists that get appended to are mutable refs. *)
|
||||||
|
let sx_append_b lst item =
|
||||||
|
match lst with
|
||||||
|
| List items -> List (items @ [item])
|
||||||
|
| ListRef r -> r := !r @ [item]; lst (* mutate in place, return same ref *)
|
||||||
|
| _ -> raise (Eval_error ("append!: expected list, got " ^ type_of lst))
|
||||||
|
|
||||||
|
(** Mutable dict-set — set key in dict, return value. *)
|
||||||
|
let sx_dict_set_b d k v =
|
||||||
|
match d, k with
|
||||||
|
| Dict tbl, String key -> Hashtbl.replace tbl key v; v
|
||||||
|
| Dict tbl, Keyword key -> Hashtbl.replace tbl key v; v
|
||||||
|
| _ -> raise (Eval_error "dict-set!: expected dict and string key")
|
||||||
|
|
||||||
|
(** Get from dict or list. *)
|
||||||
|
let get_val container key =
|
||||||
|
match container, key with
|
||||||
|
| CekState s, String k ->
|
||||||
|
(match k with
|
||||||
|
| "control" -> s.cs_control | "env" -> s.cs_env
|
||||||
|
| "kont" -> s.cs_kont | "phase" -> String s.cs_phase
|
||||||
|
| "value" -> s.cs_value | _ -> Nil)
|
||||||
|
| CekFrame f, String k ->
|
||||||
|
(match k with
|
||||||
|
| "type" -> String f.cf_type | "env" -> f.cf_env
|
||||||
|
| "name" -> f.cf_name | "body" -> f.cf_body
|
||||||
|
| "remaining" -> f.cf_remaining | "f" -> f.cf_f
|
||||||
|
| "args" -> f.cf_args | "evaled" -> f.cf_args
|
||||||
|
| "results" -> f.cf_results | "raw-args" -> f.cf_results
|
||||||
|
| "then" -> f.cf_body | "else" -> f.cf_name
|
||||||
|
| "ho-type" -> f.cf_extra | "scheme" -> f.cf_extra
|
||||||
|
| "indexed" -> f.cf_extra | "value" -> f.cf_extra
|
||||||
|
| "phase" -> f.cf_extra | "has-effects" -> f.cf_extra
|
||||||
|
| "match-val" -> f.cf_extra | "current-item" -> f.cf_extra
|
||||||
|
| "update-fn" -> f.cf_extra | "head-name" -> f.cf_extra
|
||||||
|
| "emitted" -> f.cf_extra2 | "effect-list" -> f.cf_extra2
|
||||||
|
| "first-render" -> f.cf_extra2
|
||||||
|
| _ -> Nil)
|
||||||
|
| Dict d, String k -> dict_get d k
|
||||||
|
| Dict d, Keyword k -> dict_get d k
|
||||||
|
| (List l | ListRef { contents = l }), Number n ->
|
||||||
|
(try List.nth l (int_of_float n) with _ -> Nil)
|
||||||
|
| Nil, _ -> Nil (* nil.anything → nil *)
|
||||||
|
| _, _ -> Nil (* type mismatch → nil (matches JS/Python behavior) *)
|
||||||
|
|
||||||
|
(** Register get as a primitive override — transpiled code calls (get d k). *)
|
||||||
|
let () =
|
||||||
|
Sx_primitives.register "get" (fun args ->
|
||||||
|
match args with
|
||||||
|
| [c; k] -> get_val c k
|
||||||
|
| [c; k; default] ->
|
||||||
|
(try
|
||||||
|
let v = get_val c k in
|
||||||
|
if v = Nil then default else v
|
||||||
|
with _ -> default)
|
||||||
|
| _ -> raise (Eval_error "get: 2-3 args"))
|
||||||
|
|
||||||
|
|
||||||
|
(* ====================================================================== *)
|
||||||
|
(* Primitive aliases — top-level functions called by transpiled code *)
|
||||||
|
(* ====================================================================== *)
|
||||||
|
|
||||||
|
(** The transpiled evaluator calls primitives directly by their mangled
|
||||||
|
OCaml name. These aliases delegate to the primitives table so the
|
||||||
|
transpiled code compiles without needing [prim_call] everywhere. *)
|
||||||
|
|
||||||
|
let _prim name = match Hashtbl.find_opt Sx_primitives.primitives name with
|
||||||
|
| Some f -> f | None -> (fun _ -> raise (Eval_error ("Missing prim: " ^ name)))
|
||||||
|
|
||||||
|
(* Collection ops *)
|
||||||
|
let first args = _prim "first" [args]
|
||||||
|
let rest args = _prim "rest" [args]
|
||||||
|
let last args = _prim "last" [args]
|
||||||
|
let nth coll i = _prim "nth" [coll; i]
|
||||||
|
let cons x l = _prim "cons" [x; l]
|
||||||
|
let append a b = _prim "append" [a; b]
|
||||||
|
let reverse l = _prim "reverse" [l]
|
||||||
|
let flatten l = _prim "flatten" [l]
|
||||||
|
let concat a b = _prim "concat" [a; b]
|
||||||
|
let slice a b = _prim "slice" [a; b]
|
||||||
|
let len a = _prim "len" [a]
|
||||||
|
let get a b = get_val a b
|
||||||
|
let sort' a = _prim "sort" [a]
|
||||||
|
let range' a = _prim "range" [a]
|
||||||
|
let unique a = _prim "unique" [a]
|
||||||
|
let zip a b = _prim "zip" [a; b]
|
||||||
|
let zip_pairs a = _prim "zip-pairs" [a]
|
||||||
|
let take a b = _prim "take" [a; b]
|
||||||
|
let drop a b = _prim "drop" [a; b]
|
||||||
|
let chunk_every a b = _prim "chunk-every" [a; b]
|
||||||
|
|
||||||
|
(* Predicates *)
|
||||||
|
let empty_p a = _prim "empty?" [a]
|
||||||
|
let nil_p a = _prim "nil?" [a]
|
||||||
|
let number_p a = _prim "number?" [a]
|
||||||
|
let string_p a = _prim "string?" [a]
|
||||||
|
let boolean_p a = _prim "boolean?" [a]
|
||||||
|
let list_p a = _prim "list?" [a]
|
||||||
|
let dict_p a = _prim "dict?" [a]
|
||||||
|
let symbol_p a = _prim "symbol?" [a]
|
||||||
|
let keyword_p a = _prim "keyword?" [a]
|
||||||
|
let contains_p a b = _prim "contains?" [a; b]
|
||||||
|
let has_key_p a b = _prim "has-key?" [a; b]
|
||||||
|
let starts_with_p a b = _prim "starts-with?" [a; b]
|
||||||
|
let ends_with_p a b = _prim "ends-with?" [a; b]
|
||||||
|
let string_contains_p a b = _prim "string-contains?" [a; b]
|
||||||
|
let odd_p a = _prim "odd?" [a]
|
||||||
|
let even_p a = _prim "even?" [a]
|
||||||
|
let zero_p a = _prim "zero?" [a]
|
||||||
|
|
||||||
|
(* String ops *)
|
||||||
|
let str' args = String (sx_str args)
|
||||||
|
let upper a = _prim "upper" [a]
|
||||||
|
let upcase a = _prim "upcase" [a]
|
||||||
|
let lower a = _prim "lower" [a]
|
||||||
|
let downcase a = _prim "downcase" [a]
|
||||||
|
let trim a = _prim "trim" [a]
|
||||||
|
let split a b = _prim "split" [a; b]
|
||||||
|
let join a b = _prim "join" [a; b]
|
||||||
|
let replace a b c = _prim "replace" [a; b; c]
|
||||||
|
let index_of a b = _prim "index-of" [a; b]
|
||||||
|
let substring a b c = _prim "substring" [a; b; c]
|
||||||
|
let string_length a = _prim "string-length" [a]
|
||||||
|
let char_from_code a = _prim "char-from-code" [a]
|
||||||
|
|
||||||
|
(* Dict ops *)
|
||||||
|
let assoc d k v = _prim "assoc" [d; k; v]
|
||||||
|
let dissoc d k = _prim "dissoc" [d; k]
|
||||||
|
let merge' a b = _prim "merge" [a; b]
|
||||||
|
let keys a = _prim "keys" [a]
|
||||||
|
let vals a = _prim "vals" [a]
|
||||||
|
let dict_set a b c = _prim "dict-set!" [a; b; c]
|
||||||
|
let dict_get a b = _prim "dict-get" [a; b]
|
||||||
|
let dict_has_p a b = _prim "dict-has?" [a; b]
|
||||||
|
let dict_delete a b = _prim "dict-delete!" [a; b]
|
||||||
|
|
||||||
|
(* Math *)
|
||||||
|
let abs' a = _prim "abs" [a]
|
||||||
|
let sqrt' a = _prim "sqrt" [a]
|
||||||
|
let pow' a b = _prim "pow" [a; b]
|
||||||
|
let floor' a = _prim "floor" [a]
|
||||||
|
let ceil' a = _prim "ceil" [a]
|
||||||
|
let round' a = _prim "round" [a]
|
||||||
|
let min' a b = _prim "min" [a; b]
|
||||||
|
let max' a b = _prim "max" [a; b]
|
||||||
|
let clamp a b c = _prim "clamp" [a; b; c]
|
||||||
|
let parse_int a = _prim "parse-int" [a]
|
||||||
|
let parse_float a = _prim "parse-float" [a]
|
||||||
|
|
||||||
|
(* Misc *)
|
||||||
|
let error msg = raise (Eval_error (value_to_str msg))
|
||||||
|
|
||||||
|
(* inspect wrapper — returns String value instead of OCaml string *)
|
||||||
|
let inspect v = String (Sx_types.inspect v)
|
||||||
|
let apply' f args = sx_apply f args
|
||||||
|
let identical_p a b = _prim "identical?" [a; b]
|
||||||
|
let _is_spread_prim a = _prim "spread?" [a]
|
||||||
|
let spread_attrs a = _prim "spread-attrs" [a]
|
||||||
|
let make_spread a = _prim "make-spread" [a]
|
||||||
|
|
||||||
|
(* Scope primitives — delegate to sx_ref.py's shared scope stacks *)
|
||||||
|
let sx_collect a b = prim_call "collect!" [a; b]
|
||||||
|
let sx_collected a = prim_call "collected" [a]
|
||||||
|
let sx_clear_collected a = prim_call "clear-collected!" [a]
|
||||||
|
let sx_emit a b = prim_call "emit!" [a; b]
|
||||||
|
let sx_emitted a = prim_call "emitted" [a]
|
||||||
|
let sx_context a b = prim_call "context" [a; b]
|
||||||
|
|
||||||
|
(* Trampoline — forward-declared in sx_ref.ml, delegates to CEK eval_expr *)
|
||||||
|
(* This is a stub; the real trampoline is wired up in sx_ref.ml after eval_expr is defined *)
|
||||||
|
let trampoline v = v
|
||||||
|
|
||||||
|
(* Value-returning type predicates — the transpiled code passes these through
|
||||||
|
sx_truthy, so they need to return Bool, not OCaml bool. *)
|
||||||
|
(* type_of returns value, not string *)
|
||||||
|
let type_of v = String (Sx_types.type_of v)
|
||||||
|
|
||||||
|
(* Env operations — accept Env-wrapped values and value keys.
|
||||||
|
The transpiled CEK machine stores envs in dicts as Env values. *)
|
||||||
|
let unwrap_env = function
|
||||||
|
| Env e -> e
|
||||||
|
| Dict d ->
|
||||||
|
(* Dict used as env — wrap it. Needed by adapter-html.sx which
|
||||||
|
passes dicts as env args (e.g. empty {} as caller env). *)
|
||||||
|
let e = Sx_types.make_env () in
|
||||||
|
Hashtbl.iter (fun k v -> ignore (Sx_types.env_bind e k v)) d;
|
||||||
|
e
|
||||||
|
| Nil ->
|
||||||
|
Sx_types.make_env ()
|
||||||
|
| v -> raise (Eval_error ("Expected env, got " ^ Sx_types.type_of v))
|
||||||
|
|
||||||
|
let env_has e name = Bool (Sx_types.env_has (unwrap_env e) (value_to_str name))
|
||||||
|
let env_get e name = Sx_types.env_get (unwrap_env e) (value_to_str name)
|
||||||
|
let env_bind e name v = Sx_types.env_bind (unwrap_env e) (value_to_str name) v
|
||||||
|
let env_set e name v = Sx_types.env_set (unwrap_env e) (value_to_str name) v
|
||||||
|
|
||||||
|
let make_env () = Env (Sx_types.make_env ())
|
||||||
|
let env_extend e = Env (Sx_types.env_extend (unwrap_env e))
|
||||||
|
let env_merge a b = Env (Sx_types.env_merge (unwrap_env a) (unwrap_env b))
|
||||||
|
|
||||||
|
(* set_lambda_name wrapper — accepts value, extracts string *)
|
||||||
|
let set_lambda_name l n = Sx_types.set_lambda_name l (value_to_str n)
|
||||||
|
|
||||||
|
let is_nil v = Bool (Sx_types.is_nil v)
|
||||||
|
let is_thunk v = Bool (Sx_types.is_thunk v)
|
||||||
|
let is_lambda v = Bool (Sx_types.is_lambda v)
|
||||||
|
let is_component v = Bool (Sx_types.is_component v)
|
||||||
|
let is_island v = Bool (Sx_types.is_island v)
|
||||||
|
let is_macro v = Bool (Sx_types.is_macro v)
|
||||||
|
let is_signal v = Bool (Sx_types.is_signal v)
|
||||||
|
let is_callable v = Bool (Sx_types.is_callable v)
|
||||||
|
let is_identical a b = Bool (a == b)
|
||||||
|
let is_primitive name = Bool (Sx_primitives.is_primitive (value_to_str name))
|
||||||
|
let get_primitive name = Sx_primitives.get_primitive (value_to_str name)
|
||||||
|
let is_spread v = match v with Spread _ -> Bool true | _ -> Bool false
|
||||||
|
|
||||||
|
(* Stubs for functions defined in sx_ref.ml — resolved at link time *)
|
||||||
|
(* These are forward-declared here; sx_ref.ml defines the actual implementations *)
|
||||||
|
|
||||||
|
(* strip-prefix *)
|
||||||
|
(* Stubs for evaluator functions — defined in sx_ref.ml but
|
||||||
|
sometimes referenced before their definition via forward calls.
|
||||||
|
These get overridden by the actual transpiled definitions. *)
|
||||||
|
|
||||||
|
let map_indexed fn coll =
|
||||||
|
List (List.mapi (fun i x -> sx_call fn [Number (float_of_int i); x]) (sx_to_list coll))
|
||||||
|
|
||||||
|
let map_dict fn d =
|
||||||
|
match d with
|
||||||
|
| Dict tbl ->
|
||||||
|
let result = Hashtbl.create (Hashtbl.length tbl) in
|
||||||
|
Hashtbl.iter (fun k v -> Hashtbl.replace result k (sx_call fn [String k; v])) tbl;
|
||||||
|
Dict result
|
||||||
|
| _ -> raise (Eval_error "map-dict: expected dict")
|
||||||
|
|
||||||
|
let for_each fn coll =
|
||||||
|
List.iter (fun x -> ignore (sx_call fn [x])) (sx_to_list coll);
|
||||||
|
Nil
|
||||||
|
|
||||||
|
let for_each_indexed fn coll =
|
||||||
|
List.iteri (fun i x -> ignore (sx_call fn [Number (float_of_int i); x])) (sx_to_list coll);
|
||||||
|
Nil
|
||||||
|
|
||||||
|
(* Continuation support *)
|
||||||
|
let continuation_p v = match v with Continuation (_, _) -> Bool true | _ -> Bool false
|
||||||
|
|
||||||
|
let make_cek_continuation captured rest_kont =
|
||||||
|
let data = Hashtbl.create 2 in
|
||||||
|
Hashtbl.replace data "captured" captured;
|
||||||
|
Hashtbl.replace data "rest-kont" rest_kont;
|
||||||
|
Continuation ((fun v -> v), Some data)
|
||||||
|
|
||||||
|
let continuation_data v = match v with
|
||||||
|
| Continuation (_, Some d) -> Dict d
|
||||||
|
| Continuation (_, None) -> Dict (Hashtbl.create 0)
|
||||||
|
| _ -> raise (Eval_error "not a continuation")
|
||||||
|
|
||||||
|
(* Dynamic wind — simplified for OCaml (no async) *)
|
||||||
|
let dynamic_wind_call before body after _env =
|
||||||
|
ignore (sx_call before []);
|
||||||
|
let result = sx_call body [] in
|
||||||
|
ignore (sx_call after []);
|
||||||
|
result
|
||||||
|
|
||||||
|
(* Scope stack — all delegated to primitives registered in sx_server.ml *)
|
||||||
|
let scope_push name value = prim_call "scope-push!" [name; value]
|
||||||
|
let scope_pop name = prim_call "scope-pop!" [name]
|
||||||
|
let scope_peek name = prim_call "scope-peek" [name]
|
||||||
|
let scope_emit name value = prim_call "scope-emit!" [name; value]
|
||||||
|
let provide_push name value = prim_call "scope-push!" [name; value]
|
||||||
|
let provide_pop name = prim_call "scope-pop!" [name]
|
||||||
|
|
||||||
|
(* Custom special forms registry — mutable dict *)
|
||||||
|
let custom_special_forms = Dict (Hashtbl.create 4)
|
||||||
|
|
||||||
|
(* register-special-form! — add a handler to the custom registry *)
|
||||||
|
let register_special_form name handler =
|
||||||
|
(match custom_special_forms with
|
||||||
|
| Dict tbl -> Hashtbl.replace tbl (value_to_str name) handler; handler
|
||||||
|
| _ -> raise (Eval_error "custom_special_forms not a dict"))
|
||||||
|
|
||||||
|
(* Render check/fn hooks — nil by default, set by platform if needed *)
|
||||||
|
let render_check = Nil
|
||||||
|
let render_fn = Nil
|
||||||
|
|
||||||
|
(* is-else-clause? — check if a cond/case test is an else marker *)
|
||||||
|
let is_else_clause v =
|
||||||
|
match v with
|
||||||
|
| Keyword k -> Bool (k = "else" || k = "default")
|
||||||
|
| Symbol s -> Bool (s = "else" || s = "default")
|
||||||
|
| Bool true -> Bool true
|
||||||
|
| _ -> Bool false
|
||||||
|
|
||||||
|
(* Signal accessors *)
|
||||||
|
let signal_value s = match s with
|
||||||
|
| Signal sig' -> sig'.s_value
|
||||||
|
| Dict d -> (match Hashtbl.find_opt d "value" with Some v -> v | None -> Nil)
|
||||||
|
| _ -> raise (Eval_error "not a signal")
|
||||||
|
let signal_set_value s v = match s with Signal sig' -> sig'.s_value <- v; v | _ -> raise (Eval_error "not a signal")
|
||||||
|
let signal_subscribers s = match s with Signal sig' -> List (List.map (fun _ -> Nil) sig'.s_subscribers) | _ -> List []
|
||||||
|
let signal_add_sub_b _s _f = Nil
|
||||||
|
let signal_remove_sub_b _s _f = Nil
|
||||||
|
let signal_deps _s = List []
|
||||||
|
let signal_set_deps _s _d = Nil
|
||||||
|
let notify_subscribers _s = Nil
|
||||||
|
let flush_subscribers _s = Nil
|
||||||
|
let dispose_computed _s = Nil
|
||||||
|
|
||||||
|
(* Island scope stubs — accept both bare OCaml fns and NativeFn values
|
||||||
|
from transpiled code (NativeFn wrapping for value-storable lambdas). *)
|
||||||
|
let with_island_scope _register_fn body_fn =
|
||||||
|
match body_fn with
|
||||||
|
| NativeFn (_, f) -> f []
|
||||||
|
| _ -> Nil
|
||||||
|
let register_in_scope _dispose_fn = Nil
|
||||||
|
|
||||||
|
(* Component type annotation stub *)
|
||||||
|
let component_set_param_types_b _comp _types = Nil
|
||||||
|
|
||||||
|
(* Parse keyword args from a call — this is defined in evaluator.sx,
|
||||||
|
the transpiled version will override this stub. *)
|
||||||
|
(* Forward-reference stubs for evaluator functions used before definition *)
|
||||||
|
let parse_comp_params _params = List [List []; Nil; Bool false]
|
||||||
|
let parse_macro_params _params = List [List []; Nil]
|
||||||
|
|
||||||
|
let parse_keyword_args _raw_args _env =
|
||||||
|
(* Stub — the real implementation is transpiled from evaluator.sx *)
|
||||||
|
List [Dict (Hashtbl.create 0); List []]
|
||||||
|
|
||||||
|
(* Make handler/query/action/page def stubs *)
|
||||||
|
let make_handler_def name params body _env = Dict (let d = Hashtbl.create 4 in Hashtbl.replace d "type" (String "handler"); Hashtbl.replace d "name" name; Hashtbl.replace d "params" params; Hashtbl.replace d "body" body; d)
|
||||||
|
let make_query_def name params body _env = make_handler_def name params body _env
|
||||||
|
let make_action_def name params body _env = make_handler_def name params body _env
|
||||||
|
let make_page_def name _opts = Dict (let d = Hashtbl.create 4 in Hashtbl.replace d "type" (String "page"); Hashtbl.replace d "name" name; d)
|
||||||
|
|
||||||
|
(* sf-def* stubs — platform-specific def-forms, not in the SX spec *)
|
||||||
|
let sf_defhandler args env =
|
||||||
|
let name = first args in let rest_args = rest args in
|
||||||
|
make_handler_def name (first rest_args) (nth rest_args (Number 1.0)) env
|
||||||
|
let sf_defquery args env = sf_defhandler args env
|
||||||
|
let sf_defaction args env = sf_defhandler args env
|
||||||
|
let sf_defpage args _env =
|
||||||
|
let name = first args in make_page_def name (rest args)
|
||||||
|
|
||||||
|
let strip_prefix s prefix =
|
||||||
|
match s, prefix with
|
||||||
|
| String s, String p ->
|
||||||
|
let pl = String.length p in
|
||||||
|
if String.length s >= pl && String.sub s 0 pl = p
|
||||||
|
then String (String.sub s pl (String.length s - pl))
|
||||||
|
else String s
|
||||||
|
| _ -> s
|
||||||
|
|
||||||
|
(* debug_log — no-op in production, used by CEK evaluator for component warnings *)
|
||||||
|
let debug_log _ _ = Nil
|
||||||
|
|
||||||
154
hosts/ocaml/lib/sx_scope.ml
Normal file
154
hosts/ocaml/lib/sx_scope.ml
Normal file
@@ -0,0 +1,154 @@
|
|||||||
|
(** Scope stacks — dynamic scope for render-time effects.
|
||||||
|
|
||||||
|
Provides scope-push!/pop!/peek, collect!/collected/clear-collected!,
|
||||||
|
scope-emit!/emitted/scope-emitted, context, and cookie access.
|
||||||
|
|
||||||
|
All functions are registered as primitives so both the CEK evaluator
|
||||||
|
and the JIT VM can find them in the same place. *)
|
||||||
|
|
||||||
|
open Sx_types
|
||||||
|
|
||||||
|
(** The shared scope stacks hashtable. Each key maps to a stack of values.
|
||||||
|
Used by aser for spread/provide/emit patterns, CSSX collect/flush, etc. *)
|
||||||
|
let scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8
|
||||||
|
|
||||||
|
(** Request cookies — set by the Python bridge before each render.
|
||||||
|
get-cookie reads from here; set-cookie is a no-op on the server. *)
|
||||||
|
let request_cookies : (string, string) Hashtbl.t = Hashtbl.create 8
|
||||||
|
|
||||||
|
(** Clear all scope stacks. Called between requests if needed. *)
|
||||||
|
let clear_all () = Hashtbl.clear scope_stacks
|
||||||
|
|
||||||
|
let () =
|
||||||
|
let register = Sx_primitives.register in
|
||||||
|
|
||||||
|
(* --- Cookies --- *)
|
||||||
|
|
||||||
|
register "get-cookie" (fun args ->
|
||||||
|
match args with
|
||||||
|
| [String name] ->
|
||||||
|
(match Hashtbl.find_opt request_cookies name with
|
||||||
|
| Some v -> String v
|
||||||
|
| None -> Nil)
|
||||||
|
| _ -> Nil);
|
||||||
|
|
||||||
|
register "set-cookie" (fun _args -> Nil);
|
||||||
|
|
||||||
|
(* --- Core scope stack operations --- *)
|
||||||
|
|
||||||
|
register "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
|
||||||
|
| _ -> Nil);
|
||||||
|
|
||||||
|
register "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);
|
||||||
|
|
||||||
|
register "scope-peek" (fun args ->
|
||||||
|
match args with
|
||||||
|
| [String name] ->
|
||||||
|
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
|
||||||
|
(match stack with v :: _ -> v | [] -> Nil)
|
||||||
|
| _ -> Nil);
|
||||||
|
|
||||||
|
(* --- Context (scope lookup with optional default) --- *)
|
||||||
|
|
||||||
|
register "context" (fun args ->
|
||||||
|
match args with
|
||||||
|
| [String name] | [String name; _] ->
|
||||||
|
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
|
||||||
|
(match stack, args with
|
||||||
|
| v :: _, _ -> v
|
||||||
|
| [], [_; default_val] -> default_val
|
||||||
|
| [], _ -> Nil)
|
||||||
|
| _ -> Nil);
|
||||||
|
|
||||||
|
(* --- Collect / collected / clear-collected! --- *)
|
||||||
|
|
||||||
|
register "collect!" (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 ->
|
||||||
|
if not (List.mem value items) then
|
||||||
|
Hashtbl.replace scope_stacks name (List (items @ [value]) :: rest)
|
||||||
|
| [] ->
|
||||||
|
Hashtbl.replace scope_stacks name [List [value]]
|
||||||
|
| _ :: _ -> ());
|
||||||
|
Nil
|
||||||
|
| _ -> Nil);
|
||||||
|
|
||||||
|
register "collected" (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 []);
|
||||||
|
|
||||||
|
register "clear-collected!" (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 (List [] :: rest)
|
||||||
|
| [] -> Hashtbl.replace scope_stacks name [List []]);
|
||||||
|
Nil
|
||||||
|
| _ -> Nil);
|
||||||
|
|
||||||
|
(* --- Emit / emitted (for spread attrs in adapter-html.sx) --- *)
|
||||||
|
|
||||||
|
register "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)
|
||||||
|
| Nil :: rest ->
|
||||||
|
Hashtbl.replace scope_stacks name (List [value] :: rest)
|
||||||
|
| [] ->
|
||||||
|
Hashtbl.replace scope_stacks name [List [value]]
|
||||||
|
| _ :: _ -> ());
|
||||||
|
Nil
|
||||||
|
| _ -> Nil);
|
||||||
|
|
||||||
|
register "emit!" (fun args ->
|
||||||
|
(* Alias for scope-emit! *)
|
||||||
|
match Sx_primitives.get_primitive "scope-emit!" with
|
||||||
|
| NativeFn (_, fn) -> fn args | _ -> Nil);
|
||||||
|
|
||||||
|
register "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 []);
|
||||||
|
|
||||||
|
register "scope-emitted" (fun args ->
|
||||||
|
match Sx_primitives.get_primitive "emitted" with
|
||||||
|
| NativeFn (_, fn) -> fn args | _ -> List []);
|
||||||
|
|
||||||
|
register "scope-collected" (fun args ->
|
||||||
|
match Sx_primitives.get_primitive "collected" with
|
||||||
|
| NativeFn (_, fn) -> fn args | _ -> List []);
|
||||||
|
|
||||||
|
register "scope-clear-collected!" (fun args ->
|
||||||
|
match Sx_primitives.get_primitive "clear-collected!" with
|
||||||
|
| NativeFn (_, fn) -> fn args | _ -> Nil);
|
||||||
|
|
||||||
|
(* --- Provide aliases --- *)
|
||||||
|
|
||||||
|
register "provide-push!" (fun args ->
|
||||||
|
match Sx_primitives.get_primitive "scope-push!" with
|
||||||
|
| NativeFn (_, fn) -> fn args | _ -> Nil);
|
||||||
|
|
||||||
|
register "provide-pop!" (fun args ->
|
||||||
|
match Sx_primitives.get_primitive "scope-pop!" with
|
||||||
|
| NativeFn (_, fn) -> fn args | _ -> Nil)
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user