sxtp: patch + signals primitives (Datastar-borrowed)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 46s

Adds two new top-level SXTP message types alongside
request/response/condition/event, modelled on Datastar's
datastar-patch-elements and datastar-patch-signals SSE events:

  (patch :target "#x" :mode outer :body (~card)) - DOM fragment
    morph. Subsumes HTMX swap modes. Mode is outer (default) |
    inner | replace | prepend | append | before | after | remove.

  (signals :values {:n 3} :only-if-missing false) - reactive
    state patch. nil value removes the signal. only-if-missing
    skips existing signals (lazy init).

A server response stream can mix both freely; clients dispatch
by head symbol, ordering preserved. Cleaner than HTMX's
swap-mode-per-trigger because the patch shape is decoupled from
the triggering element/attribute.

Spec at applications/sxtp/spec.sx (patch-fields, signals-fields,
patch-modes, example-patch-stream). Constructors / predicates /
accessors / serialise / parse in lib/host/sxtp.sx. 25 new tests
in lib/host/tests/sxtp.sx (predicates, mode normalisation, fixed
field order, remove-without-body, signals round-trip). Host
conformance 129/129 (was 104/104).

Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
This commit is contained in:
2026-06-30 15:22:37 +00:00
parent fac15d6140
commit 1d02afb64a
3 changed files with 148 additions and 5 deletions

View File

@@ -4,10 +4,10 @@
;; at applications/sxtp/spec.sx.
;;
;; Representation: internally a message is a plain dict tagged by :msg ("request"
;; /"response"/"condition"/"event"), with string keys so the keyword==string rule
;; makes construction and access trivial. verb/status/type are stored as SYMBOLS
;; (they ride the wire bare, not quoted). The wire LIST form is produced/consumed
;; only at the serialise/parse boundary:
;; /"response"/"condition"/"event"/"patch"/"signals"), with string keys so the
;; keyword==string rule makes construction and access trivial. verb/status/type/
;; mode are stored as SYMBOLS (they ride the wire bare, not quoted). The wire
;; LIST form is produced/consumed only at the serialise/parse boundary:
;; sxtp/serialize : msg-dict -> text/sx string
;; sxtp/parse : text/sx string -> msg-dict
;; A Dream HTTP request/response bridges to/from SXTP via sxtp/from-dream and
@@ -35,6 +35,21 @@
(fn (etype opts)
(merge {:msg "event" :type (sxtp/-sym etype)} opts)))
;; Patch (Datastar-borrowed) — DOM fragment morph.
;; target: CSS selector (required). mode in opts defaults to outer; accepts
;; string OR symbol and is normalised. mode values: outer | inner | replace |
;; prepend | append | before | after | remove. body: SX subtree (omit for remove).
(define sxtp/patch
(fn (target opts)
(let ((mode (or (get opts :mode) "outer")))
(merge opts {:msg "patch" :target target :mode (sxtp/-sym mode)}))))
;; Signals (Datastar-borrowed) — reactive state patch.
;; values: dict of signal-name -> new-value (nil removes). only-if-missing: bool.
(define sxtp/signals
(fn (values opts)
(merge {:msg "signals" :values values} opts)))
;; ── predicates ─────────────────────────────────────────────────────
(define sxtp/-is?
(fn (m tag) (and (= (type-of m) "dict") (= (get m :msg) tag))))
@@ -42,6 +57,8 @@
(define sxtp/response? (fn (m) (sxtp/-is? m "response")))
(define sxtp/condition? (fn (m) (sxtp/-is? m "condition")))
(define sxtp/event? (fn (m) (sxtp/-is? m "event")))
(define sxtp/patch? (fn (m) (sxtp/-is? m "patch")))
(define sxtp/signals? (fn (m) (sxtp/-is? m "signals")))
;; ── accessors ──────────────────────────────────────────────────────
(define sxtp/verb (fn (m) (get m :verb)))
@@ -56,6 +73,11 @@
(define sxtp/stream? (fn (m) (= (get m :stream) true)))
(define sxtp/cond-type (fn (m) (get m :type)))
(define sxtp/cond-message (fn (m) (get m :message)))
(define sxtp/target (fn (m) (get m :target)))
(define sxtp/mode (fn (m) (get m :mode)))
(define sxtp/values (fn (m) (get m :values)))
(define sxtp/only-if-missing? (fn (m) (= (get m :only-if-missing) true)))
(define sxtp/transition? (fn (m) (= (get m :transition) true)))
;; ── status helpers (build responses) ───────────────────────────────
(define sxtp/ok (fn (body) (sxtp/response "ok" {:body body})))
@@ -121,7 +143,9 @@
{:request (list :verb :path :headers :cookies :params :capabilities :body)
:response (list :status :headers :set-cookie :body :stream)
:condition (list :type :message :path :retry :detail)
:event (list :type :id :body :time)})
:event (list :type :id :body :time)
:patch (list :target :mode :body :transition)
:signals (list :values :only-if-missing)})
;; A nested SXTP message (a condition/event in a :body) serialises in its own
;; list form; plain data values go through the serialize primitive.
(define sxtp/-emit-value

View File

@@ -24,6 +24,10 @@
(host-sx-test "request not response" (sxtp/response? host-sx-req) false)
(host-sx-test "response?" (sxtp/response? host-sx-resp) true)
(host-sx-test "condition?" (sxtp/condition? (sxtp/condition "x" {})) true)
(host-sx-test "patch?" (sxtp/patch? (sxtp/patch "#x" {})) true)
(host-sx-test "patch not event" (sxtp/event? (sxtp/patch "#x" {})) false)
(host-sx-test "signals?" (sxtp/signals? (sxtp/signals {:n 3} {})) true)
(host-sx-test "signals not patch" (sxtp/patch? (sxtp/signals {:n 3} {})) false)
;; ── accessors (verb/status are symbols) ────────────────────────────
(host-sx-test "verb" (symbol->string (sxtp/verb host-sx-req)) "navigate")
@@ -68,6 +72,68 @@
(contains? (sxtp/serialize host-sx-resp) ":msg")
false)
;; ── patch + signals (Datastar-borrowed) ───────────────────────────
;; Mode defaults to outer; accepts string OR symbol input.
(host-sx-test
"patch default mode is outer symbol"
(symbol->string (sxtp/mode (sxtp/patch "#x" {})))
"outer")
(host-sx-test
"patch accepts symbol mode"
(symbol->string (sxtp/mode (sxtp/patch "#x" {:mode (string->symbol "inner")})))
"inner")
(host-sx-test
"patch accepts string mode and normalises"
(symbol->string (sxtp/mode (sxtp/patch "#x" {:mode "append"})))
"append")
(host-sx-test
"patch target accessor"
(sxtp/target (sxtp/patch "#cart" {}))
"#cart")
(host-sx-test
"patch serialises with target/mode/body in fixed order"
(sxtp/serialize (sxtp/patch "#x" {:body "hi"}))
"(patch :target \"#x\" :mode outer :body \"hi\")")
(host-sx-test
"patch remove mode serialises without :body"
(sxtp/serialize (sxtp/patch "#x" {:mode "remove"}))
"(patch :target \"#x\" :mode remove)")
(host-sx-test
"patch transition? predicate"
(sxtp/transition? (sxtp/patch "#x" {:transition true}))
true)
(host-sx-test
"signals accessor"
(get (sxtp/values (sxtp/signals {:cart/count 3} {})) :cart/count)
3)
(host-sx-test
"signals only-if-missing default false"
(sxtp/only-if-missing? (sxtp/signals {:n 1} {}))
false)
(host-sx-test
"signals only-if-missing true round-trips"
(sxtp/only-if-missing? (sxtp/signals {:n 1} {:only-if-missing true}))
true)
(host-sx-test
"signals serialise"
(sxtp/serialize (sxtp/signals {:cart/count 3} {}))
"(signals :values {:cart/count 3})")
;; ── round-trip ────────────────────────────────────────────────────
(define host-sx-patch-rt
(sxtp/parse (sxtp/serialize (sxtp/patch "#mini" {:mode "inner" :body "n=3"}))))
(host-sx-test "patch rt msg" (sxtp/patch? host-sx-patch-rt) true)
(host-sx-test "patch rt target" (sxtp/target host-sx-patch-rt) "#mini")
(host-sx-test "patch rt mode" (symbol->string (sxtp/mode host-sx-patch-rt)) "inner")
(define host-sx-signals-rt
(sxtp/parse (sxtp/serialize (sxtp/signals {:a 1 :b "x"} {:only-if-missing true}))))
(host-sx-test "signals rt msg" (sxtp/signals? host-sx-signals-rt) true)
(host-sx-test "signals rt values"
(get (sxtp/values host-sx-signals-rt) :a) 1)
(host-sx-test "signals rt only-if-missing"
(sxtp/only-if-missing? host-sx-signals-rt) true)
;; ── parse + round-trip ─────────────────────────────────────────────
(define host-sx-parsed
(sxtp/parse "(request :verb query :path \"/events\" :headers {:host \"h\"})"))