diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 944d1ced..7d6a9607 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -94,20 +94,25 @@ ;; type-post, and types ARE posts (same blog: namespace). (define host/blog--node (fn (slug) (string->symbol (str "blog:" slug)))) +;; Relations are POSTS (plans/relations-as-posts.md). Each relation-post is-a +;; `relation` and owns its metadata in a :rel slot {:symmetric :label +;; :inverse-label}. To keep RENDER paths perform-free — a durable read inside the +;; http-listen render VM raises VmSuspended — the relation specs are loaded into an +;; in-memory cache at boot, exactly like edges (host/blog-load-edges!). kind-spec / +;; rel-kinds / kind-symmetric? then read the cache (pure); the relation-posts stay +;; the durable source of truth. host/blog-load-rel-kinds! re-reads them. +(define host/blog--rel-cache (dict)) +(define host/blog-load-rel-kinds! + (fn () + (for-each + (fn (kind) + (let ((m (get (host/blog-get kind) :rel))) + (when m (dict-set! host/blog--rel-cache kind (merge {:kind kind} m))))) + (host/blog-in "relation" "is-a")))) ;; relations are flat: direct is-a is enough +;; spec = the cached :rel metadata + :kind; nil for a non-relation (relate validates). +(define host/blog--kind-spec (fn (kind) (get host/blog--rel-cache kind))) (define host/blog-rel-kinds - (list - {:kind "related" :label "Related posts" :symmetric true :candidates "all"} - {:kind "is-a" :label "Types" :symmetric false :candidates "types" - :inverse-label "Instances"} - {:kind "subtype-of" :label "Subtype of" :symmetric false :candidates "types" - :inverse-label "Subtypes"} - {:kind "tagged" :label "Tags" :symmetric false :candidates "tags" - :inverse-label "Tagged with this"})) - -;; registry lookup; nil for an unknown kind (relate validates against this) -(define host/blog--kind-spec - (fn (kind) - (reduce (fn (acc k) (if (= (get k :kind) kind) k acc)) nil host/blog-rel-kinds))) + (fn () (map (fn (k) (get host/blog--rel-cache k)) (keys host/blog--rel-cache)))) (define host/blog--kind-symmetric? (fn (kind) (let ((s (host/blog--kind-spec kind))) (and s (get s :symmetric))))) @@ -303,6 +308,19 @@ (define host/blog-type-valid? (fn (slug content) (= (len (host/blog-type-issues slug content)) 0))) +;; Seed a relation-post: a post that is-a `relation` and carries its metadata in a +;; :rel slot. Idempotent (the record is written once; the is-a edge is a set). +(define host/blog--seed-rel! + (fn (slug title symmetric label inverse-label) + (begin + (when (not (host/blog-exists? slug)) + (persist/backend-kv-put host/blog-store (host/blog--key slug) + {:slug slug :title title + :sx-content (str "(article (h1 \"" title "\") (p \"A relation — posts link to each other through it. Its symmetry and labels live on this post.\"))") + :status "published" + :rel {:symmetric symmetric :label label :inverse-label inverse-label}})) + (host/blog-relate! slug "relation" "is-a")))) + ;; Seed the root type-posts: "type" (the root) and "tag" (a kind of type). Types ;; ARE posts, so these are real posts that document themselves; tag subtype-of ;; type means anything that is-a tag is, transitively, a type. Idempotent — safe @@ -310,6 +328,15 @@ (define host/blog-seed-types! (fn () (begin + ;; relations are posts too — `relation` is their root; each relation-post + ;; is-a relation and owns its symmetry + labels (plans/relations-as-posts.md). + (host/blog-seed! "relation" "Relation" + "(article (h1 \"Relation\") (p \"The root of relations. A relation is a typed edge between posts; each relation-post declares its symmetry and labels, and a type anchors its object end (which gives the picker its candidates).\"))" + "published") + (host/blog--seed-rel! "related" "related" true "Related posts" nil) + (host/blog--seed-rel! "is-a" "is a" false "Types" "Instances") + (host/blog--seed-rel! "subtype-of" "subtype of" false "Subtype of" "Subtypes") + (host/blog--seed-rel! "tagged" "tagged" false "Tags" "Tagged with this") (host/blog-seed! "type" "Type" "(article (h1 \"Type\") (p \"The root type. Types are posts — so this is a post that documents the idea of a type. A post declares its types with is-a edges; types form a hierarchy with subtype-of edges.\"))" "published") @@ -620,30 +647,35 @@ ;; per kind). The picker's candidates come from the kind's registry :candidates ;; ("all" / tags / types). (define host/blog--relation-editor - (fn (slug kind) + (fn (slug kind with-cands) ;; current edges read up front (a perform) — NOT inside the quasiquote, where ;; a perform would raise VmSuspended under http-listen. (let ((spec (host/blog--kind-spec kind)) (current (host/blog-out slug kind)) - ;; the results