content: nested block trees (section.sx) + 25 tests (410/410)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
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:
@@ -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")
|
||||
|
||||
@@ -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
|
||||
}
|
||||
|
||||
@@ -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
103
lib/content/section.sx
Normal 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))))
|
||||
99
lib/content/tests/section.sx
Normal file
99
lib/content/tests/section.sx
Normal 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"))
|
||||
Reference in New Issue
Block a user