host: relations-as-posts slice 1 — declaration-driven candidate pools
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
Types declare which relation they anchor (type declares is-a/subtype-of, tag declares tagged) via a 'declares' edge; the picker's candidate set is the down-closure of a relation's anchors through is-a ∪ subtype-of. So is-a/subtype-of now offer the WHOLE type closure — the roots (type/tag/article) AND instances — fixing the wrinkle where only instances showed and you could never pick 'tag' or 'article' as a type. 'related' has no anchor → every post. Replaces the hardcoded :candidates "types"/"tags"/"all" with graph queries (host/blog--reach-down + the declares edges). Design + roadmap (relations as first-class posts, typed relations, type algebra, constraints) in plans/relations-as-posts.md. host conformance 283/283 (+5: is-a pool includes type roots, excludes plain posts, tagged anchored by tag, related = all, is-a relate-options offers Article). Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -322,27 +322,55 @@
|
||||
(host/blog-seed! "article" "Article"
|
||||
"(article (h1 \"Article\") (p \"A kind of post that must have a heading. A post that is-a article is checked against this type's schema on save — gradual typing: declaring the type adds the requirement, and the next edit must satisfy it.\"))"
|
||||
"published")
|
||||
(host/blog-relate! "article" "type" "subtype-of"))))
|
||||
(host/blog-relate! "article" "type" "subtype-of")
|
||||
;; relation DECLARATIONS (see plans/relations-as-posts.md). A type-post declares
|
||||
;; which relation it anchors at its OBJECT end ("you may point at me with R"); the
|
||||
;; picker's candidate set is the down-closure of a relation's anchors through the
|
||||
;; type graph, so the candidates for a relation are exactly the posts that inherit
|
||||
;; its declaration. `type` anchors is-a + subtype-of (you point at a type), `tag`
|
||||
;; anchors tagged (you point at a tag). `related` has no anchor → every post.
|
||||
(host/blog-relate! "type" "is-a" "declares")
|
||||
(host/blog-relate! "type" "subtype-of" "declares")
|
||||
(host/blog-relate! "tag" "tagged" "declares"))))
|
||||
|
||||
;; ── relate picker (filterable, paginated candidate list) ────────────
|
||||
;; Candidates to relate `slug` to: every post except itself and ones already
|
||||
;; related, narrowed by `q` (case-insensitive substring of title or slug),
|
||||
;; title-sorted. One page is `host/blog--picker-limit` rows from `offset`.
|
||||
(define host/blog--picker-limit 20)
|
||||
;; The candidate POOL for a kind comes from its registry :candidates: "all" posts,
|
||||
;; or the members of a type ("tags" = instances of tag, "types" = instances of
|
||||
;; type). Enumerating a type's members is O(#subtypes), not O(#posts).
|
||||
;; Down-closure: every post reachable from `roots` by walking INVERSE is-a ∪
|
||||
;; subtype-of edges (i.e. instances and subtypes, transitively), roots included.
|
||||
;; This is "everything that is, transitively, an instance-or-subtype of a root".
|
||||
;; BFS over direct edges (host/blog-in); `seen` makes it cycle-safe and terminating.
|
||||
(define host/blog--reach-down
|
||||
(fn (roots)
|
||||
(let loop ((frontier roots) (seen (list)))
|
||||
(if (empty? frontier)
|
||||
seen
|
||||
(let ((t (first frontier)))
|
||||
(if (contains? seen t)
|
||||
(loop (rest frontier) seen)
|
||||
(loop
|
||||
(concat (rest frontier)
|
||||
(concat (host/blog-in t "is-a") (host/blog-in t "subtype-of")))
|
||||
(concat seen (list t)))))))))
|
||||
|
||||
;; The candidate POOL for relating under `kind` is DECLARATION-driven (see
|
||||
;; plans/relations-as-posts.md): the down-closure of the posts that DECLARE `kind`
|
||||
;; at their object end. So is-a/subtype-of (anchored by `type`) offer the whole type
|
||||
;; closure — roots AND instances — and `tagged` (anchored by `tag`) offers the tags.
|
||||
;; A relation with no declaration (e.g. `related`) offers every post.
|
||||
(define host/blog--candidate-pool
|
||||
(fn (candidates)
|
||||
(cond
|
||||
((= candidates "tags") (host/blog-instances-of "tag"))
|
||||
((= candidates "types") (host/blog-instances-of "type"))
|
||||
(else (host/blog-slugs)))))
|
||||
(fn (kind)
|
||||
(let ((anchors (host/blog-in kind "declares")))
|
||||
(if (empty? anchors)
|
||||
(host/blog-slugs)
|
||||
(host/blog--reach-down anchors)))))
|
||||
|
||||
(define host/blog--relate-candidates
|
||||
(fn (slug q kind)
|
||||
(let ((spec (host/blog--kind-spec kind)))
|
||||
(let ((pool (host/blog--candidate-pool (get spec :candidates)))
|
||||
(let ((pool (host/blog--candidate-pool kind))
|
||||
(already (host/blog-out slug kind))
|
||||
(ql (lower (or q ""))))
|
||||
;; pool is slugs; resolve titles, drop self + already-linked, filter by q
|
||||
|
||||
Reference in New Issue
Block a user