content: nested block trees (section.sx) + 25 tests (410/410)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-06-07 01:56:22 +00:00
parent 897172a5b8
commit 6e0edc347b
6 changed files with 219 additions and 5 deletions

View File

@@ -15,7 +15,7 @@ if [ ! -x "$SX_SERVER" ]; then
fi
fi
SUITES=(block doc render api meta markdown text validate store snapshot crdt crdt-store sync md-import fed)
SUITES=(block doc render api meta markdown text section validate store snapshot crdt crdt-store sync md-import fed)
OUT_JSON="lib/content/scoreboard.json"
OUT_MD="lib/content/scoreboard.md"
@@ -44,6 +44,7 @@ run_suite() {
(load "lib/content/api.sx")
(load "lib/content/meta.sx")
(load "lib/content/text.sx")
(load "lib/content/section.sx")
(load "lib/content/markdown.sx")
(load "lib/content/validate.sx")
(load "lib/content/store.sx")

View File

@@ -7,6 +7,7 @@
"meta": {"pass": 27, "fail": 0},
"markdown": {"pass": 20, "fail": 0},
"text": {"pass": 20, "fail": 0},
"section": {"pass": 25, "fail": 0},
"validate": {"pass": 17, "fail": 0},
"store": {"pass": 29, "fail": 0},
"snapshot": {"pass": 20, "fail": 0},
@@ -16,7 +17,7 @@
"md-import": {"pass": 24, "fail": 0},
"fed": {"pass": 20, "fail": 0}
},
"total_pass": 385,
"total_pass": 410,
"total_fail": 0,
"total": 385
"total": 410
}

View File

@@ -11,6 +11,7 @@ _Generated by `lib/content/conformance.sh`_
| meta | 27 | 0 | 27 |
| markdown | 20 | 0 | 20 |
| text | 20 | 0 | 20 |
| section | 25 | 0 | 25 |
| validate | 17 | 0 | 17 |
| store | 29 | 0 | 29 |
| snapshot | 20 | 0 | 20 |
@@ -19,4 +20,4 @@ _Generated by `lib/content/conformance.sh`_
| sync | 14 | 0 | 14 |
| md-import | 24 | 0 | 24 |
| fed | 20 | 0 | 20 |
| **Total** | **385** | **0** | **385** |
| **Total** | **410** | **0** | **410** |

103
lib/content/section.sx Normal file
View File

@@ -0,0 +1,103 @@
;; content-on-sx — nested block trees (section container).
;;
;; CtSection is a block whose ivar `children` is an ordered list of blocks (any
;; type, including nested sections → arbitrary depth). This turns the document
;; from a flat sequence into the ordered TREE of the architecture sketch.
;;
;; Self-contained: CtSection answers asHTML/asSx/asText/asMarkdown: by folding
;; its children's renderings — pure polymorphic recursion, so it composes with
;; the existing render boundary with no changes to block.sx or render.sx. (The
;; relevant per-block render bootstrap must be loaded for the children.)
;;
;; Requires (loaded by harness): block.sx, doc.sx, render.sx (asHTML/asSx);
;; markdown.sx / text.sx for those formats on children.
(define
content-bootstrap-section!
(fn
()
(begin
(st-class-define! "CtSection" "CtBlock" (list "children"))
(ct-def-method! "CtSection" "children" "children ^ children")
(ct-def-method! "CtSection" "type" "type ^ #section")
(ct-def-method!
"CtSection"
"asHTML"
"asHTML ^ '<section>' , (children inject: '' into: [:a :b | a , (b asHTML)]) , '</section>'")
(ct-def-method!
"CtSection"
"asSx"
"asSx ^ '(section ' , (children inject: '' into: [:a :b | a , (b asSx)]) , ')'")
(ct-def-method!
"CtSection"
"asText"
"asText ^ (children inject: '' into: [:a :b | (b asText = '') ifTrue: [a] ifFalse: [(a = '' ifTrue: [b asText] ifFalse: [a , ' ' , b asText])]])")
(ct-def-method!
"CtSection"
"asMarkdown:"
"asMarkdown: nl ^ (children inject: '' into: [:a :b | a , (a = '' ifTrue: [''] ifFalse: [nl , nl]) , (b asMarkdown: nl)])")
true)))
(define
mk-section
(fn
(id children)
(st-iv-set!
(st-iv-set! (st-make-instance "CtSection") "id" id)
"children"
children)))
(define
section?
(fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
(define section-children (fn (sec) (st-send sec "children" (list))))
;; copy-on-write child edits (return a new section)
(define
section-with-children
(fn (sec children) (st-iv-set! sec "children" children)))
(define
section-append
(fn
(sec block)
(section-with-children sec (append (section-children sec) (list block)))))
;; ── tree traversal (descends into nested sections) ──
(define
block-deep-find
(fn
(blocks id)
(if
(= (len blocks) 0)
nil
(let
((b (first blocks)))
(if
(= (blk-id b) id)
b
(let
((nested (if (section? b) (block-deep-find (section-children b) id) nil)))
(if (= nested nil) (block-deep-find (rest blocks) id) nested)))))))
(define doc-deep-find (fn (doc id) (block-deep-find (doc-blocks doc) id)))
(define
block-tree-ids
(fn
(blocks)
(if
(= (len blocks) 0)
(list)
(let
((b (first blocks)))
(append
(cons
(blk-id b)
(if (section? b) (block-tree-ids (section-children b)) (list)))
(block-tree-ids (rest blocks)))))))
(define doc-tree-ids (fn (doc) (block-tree-ids (doc-blocks doc))))
(define block-tree-count (fn (blocks) (len (block-tree-ids blocks))))
(define doc-tree-count (fn (doc) (len (doc-tree-ids doc))))

View File

@@ -0,0 +1,99 @@
;; Extension — nested block trees (CtSection container).
(st-bootstrap-classes!)
(content/bootstrap!)
(content-bootstrap-markdown!)
(content-bootstrap-text!)
(content-bootstrap-section!)
(define nl (str "\n"))
;; ── a section is a block ──
(define
sec
(mk-section
"s"
(list (mk-heading "h" 2 "Hi") (mk-text "p" "Body"))))
(content-test "section is block" (block? sec) true)
(content-test "section? yes" (section? sec) true)
(content-test "section? no on text" (section? (mk-text "x" "y")) false)
(content-test "section type" (blk-type sec) "section")
(content-test "section id" (blk-id sec) "s")
(content-test
"section children count"
(len (section-children sec))
2)
;; ── recursive render ──
(content-test
"section html"
(asHTML sec)
"<section><h2>Hi</h2><p>Body</p></section>")
(content-test "section sx" (asSx sec) "(section (h2 \"Hi\")(p \"Body\"))")
(content-test "section text" (asText sec) "Hi Body")
(content-test
"empty section html"
(asHTML (mk-section "e" (list)))
"<section></section>")
;; ── nested in a document ──
(define
d
(doc-append
(doc-append (doc-empty "d") (mk-heading "top" 1 "Top"))
sec))
(content-test
"doc with section html"
(asHTML d)
"<h1>Top</h1><section><h2>Hi</h2><p>Body</p></section>")
(content-test "doc top-level ids" (doc-ids d) (list "top" "s"))
;; ── arbitrary depth ──
(define
deep
(mk-section
"outer"
(list
(mk-text "a" "A")
(mk-section
"inner"
(list (mk-text "b" "B") (mk-heading "c" 3 "C"))))))
(content-test
"deep html"
(asHTML deep)
"<section><p>A</p><section><p>B</p><h3>C</h3></section></section>")
(content-test "deep text" (asText deep) "A B C")
;; ── tree traversal descends into sections ──
(define dd (doc-append (doc-empty "d") deep))
(content-test "deep-find nested" (blk-id (doc-deep-find dd "b")) "b")
(content-test
"deep-find deeper"
(str (blk-send (doc-deep-find dd "c") "text"))
"C")
(content-test "deep-find missing" (doc-deep-find dd "zzz") nil)
(content-test
"deep-find top-level"
(blk-id (doc-deep-find dd "outer"))
"outer")
(content-test
"tree-ids flattened"
(doc-tree-ids dd)
(list "outer" "a" "inner" "b" "c"))
(content-test "tree-count" (doc-tree-count dd) 5)
(content-test "top-level ids still flat" (doc-ids dd) (list "outer"))
;; ── copy-on-write child edits ──
(define sec2 (section-append sec (mk-divider "dv")))
(content-test "section-append" (len (section-children sec2)) 3)
(content-test
"section-append immutable"
(len (section-children sec))
2)
(content-test
"section-append renders"
(asHTML sec2)
"<section><h2>Hi</h2><p>Body</p><hr></section>")
;; ── markdown of a section (children joined by blank line) ──
(content-test "section markdown" (asMarkdown sec) (str "## Hi" nl nl "Body"))