diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 51f16680..24cae789 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -545,24 +545,53 @@ (fn (req) (let ((al (str (or (dream-header req "accept-language") "")))) (if (>= (len al) 2) (substr al 0 2) "en")))) -;; the `ref` transclude resolver (compose.sx asks the context for "ref"): render the -;; referenced object. A decomposed card object is-a a card-type with field-values + the -;; card-type carries a :template, so it renders via the SAME typed-block path articles -;; use; render-page turns that SX tree into HTML. Empty for an absent / template-less ref. +;; ── ref addressing: relative-stored, resolve-in-context (IPNS-like) ───────────────── +;; A ref in a :body is RELATIVE by default — a field-path like "body__b0" (logical: body/b0), +;; resolved against the object being rendered (the "container" in the context). So the same +;; body is portable: it doesn't pin the container's name. A card's storage slug is +;; ____ (routing-safe — a single URL segment). A cross-domain ref is +;; ABSOLUTE with an authority: "market:obj__field__card" — the resolver dispatches on the +;; prefix (local today; fetch_data / ActivityPub for a remote authority later). A snapshot/ +;; publish op (future) freezes all refs to absolute CIDs. This is the naming layer; the CID +;; (content hash of the record, incl :body) is the immutable-identity layer on top. +(define host/blog--card-slug + (fn (container field name) (str container "__" field "__" name))) +;; resolve a ref string (relative field-path, or authority:slug) to a LOCAL storage slug, +;; or "" if it's a remote authority we can't fetch yet. +(define host/blog--resolve-ref + (fn (refstr ctx) + (let ((container (str (or (get ctx "container") "")))) + (if (contains? refstr ":") + (let ((p (index-of refstr ":"))) + (let ((auth (substr refstr 0 p)) (rest-slug (substr refstr (+ p 1)))) + (if (or (= auth "blog") (= auth container)) rest-slug ""))) ;; local authority -> the slug; remote -> unresolved (seam) + (if (= container "") refstr + ;; relative resolution: __. COMPAT: an older body may store an + ;; ABSOLUTE ref (the full card slug) — if the relative form is absent but the ref + ;; already names an existing object, use it directly. + (let ((rel (str container "__" refstr))) + (if (host/blog-exists? rel) rel (if (host/blog-exists? refstr) refstr rel)))))))) +;; the `ref` transclude resolver (compose.sx asks the context for "ref"): RESOLVE the ref in +;; context, then render the resolved card object. A card is-a a card-type with field-values + +;; the card-type carries a :template, so it renders via the SAME typed-block path articles +;; use; render-page turns that SX tree into HTML. Empty for an absent / remote / bare ref. (define host/blog--comp-ref - (fn (slug ctx) - (let ((tb (host/blog--typed-block slug))) - (if (= tb "") "" (render-page tb))))) + (fn (refstr ctx) + (let ((slug (host/blog--resolve-ref refstr ctx))) + (if (= slug "") "" + (let ((tb (host/blog--typed-block slug))) + (if (= tb "") "" (render-page tb))))))) ;; the render context for a :body: auth from the principal + live device/locale from the -;; request + the graph-query resolver + the transclude resolver. The context is the -;; EXECUTION environment — the object (its when-variants) is the definition; this picks -;; which path renders. +;; request + the graph-query resolver + the transclude resolver + the CONTAINER (the object +;; being rendered, so relative refs resolve). The context is the EXECUTION environment — the +;; object (its when-variants) is the definition; this picks which path renders. (define host/blog--comp-ctx - (fn (principal req) + (fn (principal req container) (merge (merge (if (nil? principal) {} {"auth" "yes"}) (if (nil? req) {} {"device" (host/blog--device-of req) "locale" (host/blog--locale-of req)})) - {"query" host/blog--comp-query "ref" host/blog--comp-ref}))) + {"query" host/blog--comp-query "ref" host/blog--comp-ref + "container" (or container "")}))) ;; ── cards-as-objects: decompose content into card OBJECTS + a `contains` body ──────── ;; A post body is not one opaque sx_content string but a `contains` DAG of separate, @@ -627,7 +656,7 @@ (let ((refs (map-indexed (fn (i block) - (let ((orig-tag (str (first block))) (cslug (str post-slug "__b" i))) + (let ((orig-tag (str (first block))) (cslug (host/blog--card-slug post-slug "body" (str "b" i)))) (let ((ctype (host/blog--tag->card-type orig-tag))) (begin ;; status "block" hides the card object from listings; it still @@ -636,7 +665,7 @@ (host/blog-relate! cslug ctype "is-a") (host/blog--set-field-values! cslug (host/blog--block-fields orig-tag ctype block)) (host/blog-relate! post-slug cslug "contains") - (list (quote ref) cslug))))) + (list (quote ref) (host/blog--slug->ref post-slug cslug)))))) blocks))) (host/blog--set-body! post-slug (cons (quote seq) refs))))))) @@ -661,16 +690,8 @@ (fn (slug) (let loop ((i 0)) (if (host/blog-exists? (str slug "__b" i)) (loop (+ i 1)) i)))) -(define host/blog-block-add! - (fn (slug ctype fields) - (let ((cslug (str slug "__b" (host/blog--next-block-idx slug)))) - (begin - (host/blog-seed! cslug ctype "(article (h1 \"card\"))" "block") - (host/blog-relate! cslug ctype "is-a") - (host/blog--set-field-values! cslug fields) - (host/blog-relate! slug cslug "contains") - (host/blog--set-body-refs! slug (concat (host/blog-body-refs slug) (list cslug))) - cslug)))) +;; legacy card-only remove (by ref slug) — kept for card-only callers/tests; the node-based +;; editor uses host/blog-block-remove-idx! (index-addressed, preserves alt/each nodes). (define host/blog-block-remove! (fn (slug cslug) (begin @@ -703,6 +724,177 @@ (fn (vals) (let ((t (str (or (get vals "text") (get vals "src") (get vals "code") (get vals "url") "")))) (if (> (len t) 60) (str (substr t 0 60) "…") t)))) + +;; ── and/or/each authoring: the :body's top-level nodes are BLOCKS of three kinds ───── +;; The :body IS the object's one root composition (inline, part of its CID). Its top-level +;; nodes are blocks: a CARD (ref -> an external card object via a `contains` edge), a +;; CONDITIONAL (alt+when — the "or": show the first branch whose condition holds), or a +;; REPEATER (each — the loop: render a template per graph-query result). seq is the "and". +;; The editor edits this inline tree; leaves stay external refs. (composition-objects.md.) +(define host/blog-body-nodes + (fn (slug) + (let ((body (host/blog-body-of slug))) + (if (and (= (type-of body) "list") (= (str (first body)) "seq")) + (rest body) (list))))) +(define host/blog--set-body-nodes! + (fn (slug nodes) (host/blog--set-body! slug (cons (quote seq) nodes)))) +;; the value at index k of a list (any element type). +(define host/blog--nth + (fn (xs k) (let loop ((i 0) (ys xs)) + (cond ((empty? ys) nil) ((= i k) (first ys)) (else (loop (+ i 1) (rest ys))))))) +;; a copy of xs without index i. +(define host/blog--remove-at + (fn (xs i) (let loop ((k 0) (ys xs) (acc (list))) + (if (empty? ys) acc + (loop (+ k 1) (rest ys) (if (= k i) acc (concat acc (list (first ys))))))))) +;; a fresh card object (is-a ctype + fields), contains-linked to `slug`; returns its slug. +;; Every block kind's leaves are card objects made this way. +;; a fresh, uniquely-named card in /. Returns its STORAGE SLUG +;; (____b); callers store the RELATIVE ref via host/blog--slug->ref. +(define host/blog--next-card-name + (fn (container field) + (let loop ((i 0)) + (if (host/blog-exists? (host/blog--card-slug container field (str "b" i))) (loop (+ i 1)) (str "b" i))))) +(define host/blog--new-card! + (fn (container field ctype fields) + (let ((cslug (host/blog--card-slug container field (host/blog--next-card-name container field)))) + (begin + (host/blog-seed! cslug ctype "(article (h1 \"card\"))" "block") + (host/blog-relate! cslug ctype "is-a") + (host/blog--set-field-values! cslug fields) + (host/blog-relate! container cslug "contains") + cslug)))) +;; a card's RELATIVE ref (field-path) from its storage slug: ____ +;; -> __. What's stored in a :body (resolve-in-context re-prepends container). +(define host/blog--slug->ref + (fn (container slug) + (if (starts-with? slug (str container "__")) (substr slug (+ (len container) 2)) slug))) +(define host/blog--append-node! + (fn (slug node) (host/blog--set-body-nodes! slug (concat (host/blog-body-nodes slug) (list node))))) +;; the kind of a body node, for the editor: "card" | "cond" | "each" | "other". +(define host/blog--node-kind + (fn (node) + (if (= (type-of node) "list") + (let ((h (str (first node)))) + (cond ((= h "ref") "card") ((= h "alt") "cond") ((= h "each") "each") (else "other"))) + "other"))) +;; every ref slug a node (transitively) contains — for `contains`-edge cleanup on remove. +(define host/blog--node-refs + (fn (node) + (if (= (type-of node) "list") + (if (= (str (first node)) "ref") + (list (str (first (rest node)))) + (reduce (fn (acc n) (concat acc (host/blog--node-refs n))) (list) (rest node))) + (list)))) +;; a `when` condition key <-> its predicate. A small decidable set over the live context +;; (auth/device/locale) — this is where responsive/personalised authoring surfaces. +(define host/blog--cond->pred + (fn (ckey) + (cond + ((= ckey "auth") (list (quote has) "auth")) + ((= ckey "device:mobile") (list (quote eq) "device" "mobile")) + ((= ckey "device:desktop") (list (quote eq) "device" "desktop")) + ((= ckey "locale:fr") (list (quote eq) "locale" "fr")) + (else (list (quote has) "auth"))))) +(define host/blog--pred->label + (fn (pred) + (if (= (type-of pred) "list") + (let ((op (str (first pred)))) + (cond + ((= op "has") (str "has " (str (first (rest pred))))) + ((= op "eq") (str (str (first (rest pred))) " = " (str (first (rest (rest pred)))))) + (else "?"))) + "?"))) +;; the when-predicate of a conditional node (alt (when P …) …), or nil. +(define host/blog--node-pred + (fn (node) + (if (and (= (host/blog--node-kind node) "cond") (>= (len (rest node)) 1)) + (let ((wb (first (rest node)))) (if (= (str (first wb)) "when") (first (rest wb)) nil)) + nil))) +;; the query TYPE of a repeater node (each (query is-a T) …), or "". +(define host/blog--node-each-type + (fn (node) + (if (and (= (host/blog--node-kind node) "each") (>= (len (rest node)) 1)) + (let ((src (first (rest node)))) + (if (and (= (type-of src) "list") (= (str (first src)) "query")) (str (first (rest (rest src)))) "")) + ""))) +;; the ref inside a branch — its last element (ref …); "" if none. Used to read the then/ +;; else refs of a conditional and the template ref of a repeater. +(define host/blog--branch-ref + (fn (branch) + (let ((n (host/blog--nth branch (- (len branch) 1)))) + (if (and (= (type-of n) "list") (= (str (first n)) "ref")) (str (first (rest n))) "")))) +(define host/blog--cond-then (fn (node) (host/blog--branch-ref (first (rest node))))) +(define host/blog--cond-else (fn (node) (host/blog--branch-ref (first (rest (rest node)))))) +(define host/blog--each-tmpl (fn (node) (host/blog--branch-ref node))) +;; a ckey (for the cond