From 90190346aa0ddf652c2a931bd8f1c1a13c07a90b Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 30 Jun 2026 07:25:49 +0000 Subject: [PATCH] =?UTF-8?q?host:=20relations-as-posts=20slice=203=20?= =?UTF-8?q?=E2=80=94=20typed=20relations=20(target-type=20constraint=20enf?= =?UTF-8?q?orced)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A relation's declares-anchor IS its target-type constraint: is-a/subtype-of (anchored by type) require a type object; tagged (anchored by tag) a tag; related (no anchor) any post. host/blog--valid-object?(kind, other) = other ∈ the relation's candidate pool — the SAME set the picker offers — and relate-submit now enforces it (invalid target = silent no-op). The picker never offers an invalid target, so this guards crafted/API requests: the jump from candidate set to an enforced relation schema. A new typed relation needs only a relation-post + a ' declares ' edge. host/blog-relate! (direct/seed) stays unvalidated — validation is a handler boundary (the seed writes 'X is-a relation', and relation isn't under type). conformance 291/291 (+4: valid-object? accepts types/tags/any, relate-submit creates the edge for a type object and no-ops for a non-type). Co-Authored-By: Claude Opus 4.8 --- lib/host/blog.sx | 18 +++++++++++++++++- lib/host/tests/blog.sx | 25 +++++++++++++++++++++++++ plans/relations-as-posts.md | 17 +++++++++++------ 3 files changed, 53 insertions(+), 7 deletions(-) diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 28945eca..136da17b 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -408,6 +408,16 @@ (host/blog-slugs) (host/blog--reach-down anchors))))) +;; Slice 3 — typed relations: a post is a valid OBJECT (target end) of `kind` iff it's +;; in the relation's declared candidate set (the down-closure of kind's declares-anchors +;; — the target-type constraint). The SAME set the picker offers, so the picker and +;; the relate endpoint agree by construction. A relation with no anchor (`related`) +;; accepts any existing post. This is what turns "candidate set" into an enforced +;; relation schema: is-a's object must be a type, tagged's must be a tag, etc. +(define host/blog--valid-object? + (fn (kind other) + (contains? (host/blog--candidate-pool kind) other))) + (define host/blog--relate-candidates (fn (slug q kind) (let ((spec (host/blog--kind-spec kind))) @@ -1006,8 +1016,14 @@ (host/blog--page req "Not found" (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug))))))) (begin + ;; …and `other` must satisfy the relation's TARGET-TYPE CONSTRAINT + ;; (host/blog--valid-object?): you can only declare `slug is-a `, + ;; tag with ``, etc. The picker never offers an invalid target, so + ;; this enforces the same schema against crafted/API requests; an invalid + ;; relate is a silent no-op (consistent with the other guards here). (when (and other (not (= other "")) (not (= other slug)) - (host/blog--kind-spec kind) (host/blog-exists? other)) + (host/blog--kind-spec kind) (host/blog-exists? other) + (host/blog--valid-object? kind other)) (host/blog-relate! slug other kind)) ;; AJAX (the picker's sx-post, carries SX-Target): return the re-rendered ;; editor for this kind so its sx-swap="outerHTML" replaces #rel-editor-KIND diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index 7ff9edbe..94e25225 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -502,6 +502,31 @@ (contains? kinds "subtype-of") (contains? kinds "tagged"))) (list true true true true)) +;; -- relations are TYPED: the target-type constraint is enforced (slice 3) -- +;; A valid object of a relation is one in its declared candidate set (the picker's +;; pool). So is-a's object must be a type, tagged's must be a tag, related's any post. +(host-bl-test "valid-object?: is-a accepts a type (article), rejects a plain post (ppost)" + (list (host/blog--valid-object? "is-a" "article") (host/blog--valid-object? "is-a" "ppost")) + (list true false)) +(host-bl-test "valid-object?: tagged accepts a tag (ocaml); related accepts any post" + (list (host/blog--valid-object? "tagged" "ocaml") (host/blog--valid-object? "related" "ppost")) + (list true true)) +;; the relate ENDPOINT enforces it: is-a to a type relates; is-a to a non-type no-ops. +(host/blog-unrelate! "alpha-post" "article" "is-a") +(host-bl-test "relate-submit: is-a to a type (article) creates the edge" + (begin + (host/blog-relate-submit (host-bl-relreq "alpha-post" "relate" + {:sx-request "true" :sx-target "#rel-editor-is-a"} "article" "is-a")) + (contains? (host/blog-out "alpha-post" "is-a") "article")) + true) +(host/blog-unrelate! "alpha-post" "article" "is-a") +(host-bl-test "relate-submit: is-a to a NON-type (beta-post) is rejected (no edge)" + (begin + (host/blog-relate-submit (host-bl-relreq "alpha-post" "relate" + {:sx-request "true" :sx-target "#rel-editor-is-a"} "beta-post" "is-a")) + (contains? (host/blog-out "alpha-post" "is-a") "beta-post")) + false) + ;; -- Phase 3: tags as posts -- (ocaml is-a tag, from the seed-types test above) (host-bl-test "is-tag?: a post that is-a tag is a tag; others are not" (list (host/blog-is-tag? "ocaml") (host/blog-is-tag? "ppost")) diff --git a/plans/relations-as-posts.md b/plans/relations-as-posts.md index 5af06deb..83b4343f 100644 --- a/plans/relations-as-posts.md +++ b/plans/relations-as-posts.md @@ -63,12 +63,17 @@ the relation's object-end declaration from the anchor**, which includes the root the picker O(1)-perform and cut the suspend/resume churn. Subject-end declarations + a proper relation-subtype closure (when relations get subtyped) also belong here. -### Slice 3 — typed relations (target-type constraints) -- A declaration carries a **target-type constraint**: the *other* end must be (an instance - of) some type. `is-a`'s object must be a type; a hypothetical `wrote`'s object must be a - `Work`. Validation on relate (and on save) = `is-a?` against the constraint. This is the - jump from "candidate set" to a real relation schema. Picker candidates and validation - read the *same* constraint. +### Slice 3 — typed relations (target-type constraints) — DONE +- The declaration's `declares`-anchor IS the target-type constraint: `is-a`/`subtype-of` + (anchored by `type`) require a type object; `tagged` (anchored by `tag`) a tag. A new + `wrote` relation needs only a `Work declares wrote` edge — fully data-driven. +- `host/blog--valid-object?(kind, other)` = `other ∈ candidate-pool(kind)` — the SAME set + the picker offers, so picker and validation agree by construction. `relate-submit` now + enforces it (an invalid target is a silent no-op, like the other guards); `related` + (no anchor) accepts any post. The picker never offers an invalid target, so this guards + crafted/API requests — the jump from "candidate set" to an enforced relation schema. +- NOTE: `host/blog-relate!` (direct/seed) stays UNVALIDATED — the seed needs to write + `X is-a relation` where `relation` isn't under `type`. Validation is a *handler* boundary. ### Slice 4 — type algebra Types are posts + `subtype-of` is a partial order ⇒ a **lattice**, and `is-a?` is transitive