content: render boundary (asHTML/asSx polymorphic) + 29 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s
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
|
||||||
fi
|
fi
|
||||||
|
|
||||||
SUITES=(block doc)
|
SUITES=(block doc render)
|
||||||
|
|
||||||
OUT_JSON="lib/content/scoreboard.json"
|
OUT_JSON="lib/content/scoreboard.json"
|
||||||
OUT_MD="lib/content/scoreboard.md"
|
OUT_MD="lib/content/scoreboard.md"
|
||||||
@@ -35,6 +35,7 @@ run_suite() {
|
|||||||
(load "lib/smalltalk/eval.sx")
|
(load "lib/smalltalk/eval.sx")
|
||||||
(load "lib/content/block.sx")
|
(load "lib/content/block.sx")
|
||||||
(load "lib/content/doc.sx")
|
(load "lib/content/doc.sx")
|
||||||
|
(load "lib/content/render.sx")
|
||||||
(epoch 2)
|
(epoch 2)
|
||||||
(eval "(define content-test-pass 0)")
|
(eval "(define content-test-pass 0)")
|
||||||
(eval "(define content-test-fail 0)")
|
(eval "(define content-test-fail 0)")
|
||||||
|
|||||||
78
lib/content/render.sx
Normal file
78
lib/content/render.sx
Normal file
@@ -0,0 +1,78 @@
|
|||||||
|
;; content-on-sx — render boundary.
|
||||||
|
;;
|
||||||
|
;; Rendering is a message, not a property switch: every block (and the document)
|
||||||
|
;; answers asHTML and asSx. The internal model carries no presentation — the
|
||||||
|
;; boundary format is chosen by which message you send. The document folds its
|
||||||
|
;; children's renderings, so (asHTML doc) / (asSx doc) are pure polymorphic
|
||||||
|
;; sends with no type dispatch in the SX layer.
|
||||||
|
;;
|
||||||
|
;; NOTE: no HTML escaping yet — text is emitted verbatim. Escaping is a boundary
|
||||||
|
;; concern to add before any untrusted content reaches render.
|
||||||
|
|
||||||
|
(define
|
||||||
|
content-bootstrap-render!
|
||||||
|
(fn
|
||||||
|
()
|
||||||
|
(begin
|
||||||
|
(ct-def-method!
|
||||||
|
"CtHeading"
|
||||||
|
"asHTML"
|
||||||
|
"asHTML | t | t := level printString. ^ '<h' , t , '>' , text , '</h' , t , '>'")
|
||||||
|
(ct-def-method! "CtText" "asHTML" "asHTML ^ '<p>' , text , '</p>'")
|
||||||
|
(ct-def-method!
|
||||||
|
"CtCode"
|
||||||
|
"asHTML"
|
||||||
|
"asHTML ^ '<pre><code class=\"language-' , language , '\">' , text , '</code></pre>'")
|
||||||
|
(ct-def-method!
|
||||||
|
"CtQuote"
|
||||||
|
"asHTML"
|
||||||
|
"asHTML ^ '<blockquote>' , text , '</blockquote>'")
|
||||||
|
(ct-def-method!
|
||||||
|
"CtImage"
|
||||||
|
"asHTML"
|
||||||
|
"asHTML ^ '<img src=\"' , src , '\" alt=\"' , alt , '\">'")
|
||||||
|
(ct-def-method!
|
||||||
|
"CtEmbed"
|
||||||
|
"asHTML"
|
||||||
|
"asHTML ^ '<iframe src=\"' , url , '\"></iframe>'")
|
||||||
|
(ct-def-method! "CtDivider" "asHTML" "asHTML ^ '<hr>'")
|
||||||
|
(ct-def-method!
|
||||||
|
"CtList"
|
||||||
|
"asHTML"
|
||||||
|
"asHTML | tag | tag := ordered ifTrue: ['ol'] ifFalse: ['ul']. ^ '<' , tag , '>' , (items inject: '' into: [:a :x | a , '<li>' , x , '</li>']) , '</' , tag , '>'")
|
||||||
|
(ct-def-method!
|
||||||
|
"CtDoc"
|
||||||
|
"asHTML"
|
||||||
|
"asHTML ^ blocks inject: '' into: [:a :b | a , (b asHTML)]")
|
||||||
|
(ct-def-method!
|
||||||
|
"CtHeading"
|
||||||
|
"asSx"
|
||||||
|
"asSx | t | t := level printString. ^ '(h' , t , ' \"' , text , '\")'")
|
||||||
|
(ct-def-method! "CtText" "asSx" "asSx ^ '(p \"' , text , '\")'")
|
||||||
|
(ct-def-method! "CtCode" "asSx" "asSx ^ '(pre (code \"' , text , '\"))'")
|
||||||
|
(ct-def-method! "CtQuote" "asSx" "asSx ^ '(blockquote \"' , text , '\")'")
|
||||||
|
(ct-def-method!
|
||||||
|
"CtImage"
|
||||||
|
"asSx"
|
||||||
|
"asSx ^ '(img :src \"' , src , '\" :alt \"' , alt , '\")'")
|
||||||
|
(ct-def-method! "CtEmbed" "asSx" "asSx ^ '(iframe :src \"' , url , '\")'")
|
||||||
|
(ct-def-method! "CtDivider" "asSx" "asSx ^ '(hr)'")
|
||||||
|
(ct-def-method!
|
||||||
|
"CtList"
|
||||||
|
"asSx"
|
||||||
|
"asSx | tag | tag := ordered ifTrue: ['ol'] ifFalse: ['ul']. ^ '(' , tag , ' ' , (items inject: '' into: [:a :x | a , '(li \"' , x , '\")']) , ')'")
|
||||||
|
(ct-def-method!
|
||||||
|
"CtDoc"
|
||||||
|
"asSx"
|
||||||
|
"asSx ^ '(article ' , (blocks inject: '' into: [:a :b | a , (b asSx)]) , ')'")
|
||||||
|
true)))
|
||||||
|
|
||||||
|
;; ── SX boundary API — pure message sends ──
|
||||||
|
(define asHTML (fn (node) (str (st-send node "asHTML" (list)))))
|
||||||
|
(define asSx (fn (node) (str (st-send node "asSx" (list)))))
|
||||||
|
|
||||||
|
;; readable aliases
|
||||||
|
(define render-html asHTML)
|
||||||
|
(define render-sx asSx)
|
||||||
|
(define block-html asHTML)
|
||||||
|
(define block-sx asSx)
|
||||||
@@ -1,9 +1,10 @@
|
|||||||
{
|
{
|
||||||
"suites": {
|
"suites": {
|
||||||
"block": {"pass": 38, "fail": 0},
|
"block": {"pass": 38, "fail": 0},
|
||||||
"doc": {"pass": 40, "fail": 0}
|
"doc": {"pass": 40, "fail": 0},
|
||||||
|
"render": {"pass": 29, "fail": 0}
|
||||||
},
|
},
|
||||||
"total_pass": 78,
|
"total_pass": 107,
|
||||||
"total_fail": 0,
|
"total_fail": 0,
|
||||||
"total": 78
|
"total": 107
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -6,4 +6,5 @@ _Generated by `lib/content/conformance.sh`_
|
|||||||
|-------|-----:|-----:|------:|
|
|-------|-----:|-----:|------:|
|
||||||
| block | 38 | 0 | 38 |
|
| block | 38 | 0 | 38 |
|
||||||
| doc | 40 | 0 | 40 |
|
| doc | 40 | 0 | 40 |
|
||||||
| **Total** | **78** | **0** | **78** |
|
| render | 29 | 0 | 29 |
|
||||||
|
| **Total** | **107** | **0** | **107** |
|
||||||
|
|||||||
73
lib/content/tests/render.sx
Normal file
73
lib/content/tests/render.sx
Normal file
@@ -0,0 +1,73 @@
|
|||||||
|
;; Phase 1 — render boundary. asHTML / asSx are polymorphic message sends on
|
||||||
|
;; blocks and the document.
|
||||||
|
|
||||||
|
(st-bootstrap-classes!)
|
||||||
|
(content-bootstrap-blocks!)
|
||||||
|
(content-bootstrap-doc!)
|
||||||
|
(content-bootstrap-render!)
|
||||||
|
|
||||||
|
(define h (mk-heading "h" 2 "Title"))
|
||||||
|
(define p (mk-text "p" "Hello"))
|
||||||
|
(define code (mk-code "c" "sx" "(+ 1 2)"))
|
||||||
|
(define q (mk-quote "q" "Ada" "to err"))
|
||||||
|
(define img (mk-image "i" "/c.png" "cat"))
|
||||||
|
(define em (mk-embed "e" "https://v/1" "vimeo"))
|
||||||
|
(define dv (mk-divider "d"))
|
||||||
|
(define ul (mk-list "u" false (list "a" "b")))
|
||||||
|
(define ol (mk-list "o" true (list "x" "y")))
|
||||||
|
|
||||||
|
;; ── per-block asHTML ──
|
||||||
|
(content-test "heading html" (asHTML h) "<h2>Title</h2>")
|
||||||
|
(content-test "text html" (asHTML p) "<p>Hello</p>")
|
||||||
|
(content-test
|
||||||
|
"code html"
|
||||||
|
(asHTML code)
|
||||||
|
"<pre><code class=\"language-sx\">(+ 1 2)</code></pre>")
|
||||||
|
(content-test "quote html" (asHTML q) "<blockquote>to err</blockquote>")
|
||||||
|
(content-test "image html" (asHTML img) "<img src=\"/c.png\" alt=\"cat\">")
|
||||||
|
(content-test "embed html" (asHTML em) "<iframe src=\"https://v/1\"></iframe>")
|
||||||
|
(content-test "divider html" (asHTML dv) "<hr>")
|
||||||
|
(content-test "ul html" (asHTML ul) "<ul><li>a</li><li>b</li></ul>")
|
||||||
|
(content-test "ol html" (asHTML ol) "<ol><li>x</li><li>y</li></ol>")
|
||||||
|
|
||||||
|
;; ── per-block asSx ──
|
||||||
|
(content-test "heading sx" (asSx h) "(h2 \"Title\")")
|
||||||
|
(content-test "text sx" (asSx p) "(p \"Hello\")")
|
||||||
|
(content-test "code sx" (asSx code) "(pre (code \"(+ 1 2)\"))")
|
||||||
|
(content-test "quote sx" (asSx q) "(blockquote \"to err\")")
|
||||||
|
(content-test "image sx" (asSx img) "(img :src \"/c.png\" :alt \"cat\")")
|
||||||
|
(content-test "embed sx" (asSx em) "(iframe :src \"https://v/1\")")
|
||||||
|
(content-test "divider sx" (asSx dv) "(hr)")
|
||||||
|
(content-test "ul sx" (asSx ul) "(ul (li \"a\")(li \"b\"))")
|
||||||
|
(content-test "ol sx" (asSx ol) "(ol (li \"x\")(li \"y\"))")
|
||||||
|
|
||||||
|
;; ── document folds children (pure message dispatch) ──
|
||||||
|
(define d (doc-append (doc-append (doc-append (doc-empty "doc") h) p) dv))
|
||||||
|
(content-test "doc html" (asHTML d) "<h2>Title</h2><p>Hello</p><hr>")
|
||||||
|
(content-test "doc sx" (asSx d) "(article (h2 \"Title\")(p \"Hello\")(hr))")
|
||||||
|
(content-test "empty doc html" (asHTML (doc-empty "e")) "")
|
||||||
|
(content-test "empty doc sx" (asSx (doc-empty "e")) "(article )")
|
||||||
|
|
||||||
|
;; ── render-* / block-* aliases ──
|
||||||
|
(content-test "render-html alias" (render-html d) (asHTML d))
|
||||||
|
(content-test "render-sx alias" (render-sx d) (asSx d))
|
||||||
|
(content-test "block-html alias" (block-html h) "<h2>Title</h2>")
|
||||||
|
|
||||||
|
;; ── render reflects edits (immutability: each render is of a version) ──
|
||||||
|
(define d2 (doc-update d "p" "text" "Edited"))
|
||||||
|
(content-test
|
||||||
|
"render after update"
|
||||||
|
(asHTML d2)
|
||||||
|
"<h2>Title</h2><p>Edited</p><hr>")
|
||||||
|
(content-test
|
||||||
|
"original render unchanged"
|
||||||
|
(asHTML d)
|
||||||
|
"<h2>Title</h2><p>Hello</p><hr>")
|
||||||
|
(content-test
|
||||||
|
"render after move"
|
||||||
|
(asHTML (doc-move d "h" 2))
|
||||||
|
"<p>Hello</p><hr><h2>Title</h2>")
|
||||||
|
(content-test
|
||||||
|
"render after delete"
|
||||||
|
(asHTML (doc-delete d "p"))
|
||||||
|
"<h2>Title</h2><hr>")
|
||||||
@@ -19,7 +19,7 @@ injected adapter, not core.
|
|||||||
|
|
||||||
## Status (rolling)
|
## Status (rolling)
|
||||||
|
|
||||||
`bash lib/content/conformance.sh` → **78/78** (Phase 1: blocks + doc)
|
`bash lib/content/conformance.sh` → **107/107** (Phase 1: blocks + doc + render)
|
||||||
|
|
||||||
## Ground rules
|
## Ground rules
|
||||||
|
|
||||||
@@ -59,7 +59,7 @@ lib/content/api.sx ── (content/edit) (content/render) (content/history) ─
|
|||||||
## Phase 1 — Block document model
|
## Phase 1 — Block document model
|
||||||
- [x] `block.sx` — typed block objects
|
- [x] `block.sx` — typed block objects
|
||||||
- [x] `doc.sx` — ordered tree, apply edit op, structural moves
|
- [x] `doc.sx` — ordered tree, apply edit op, structural moves
|
||||||
- [ ] `render.sx` — block tree → HTML/SX
|
- [x] `render.sx` — block tree → HTML/SX
|
||||||
- [ ] `api.sx` + tests + scoreboard + conformance.sh
|
- [ ] `api.sx` + tests + scoreboard + conformance.sh
|
||||||
|
|
||||||
## Phase 2 — Op log + versioning
|
## Phase 2 — Op log + versioning
|
||||||
@@ -77,6 +77,13 @@ lib/content/api.sx ── (content/edit) (content/render) (content/history) ─
|
|||||||
|
|
||||||
## Progress log
|
## Progress log
|
||||||
|
|
||||||
|
- 2026-06-07 — Phase 1 `render.sx`: render boundary as polymorphic message
|
||||||
|
dispatch. Every block and `CtDoc` answers `asHTML` / `asSx`; the document
|
||||||
|
folds children via Smalltalk `inject:into:` (works on raw SX lists), so
|
||||||
|
`(asHTML doc)` / `(asSx doc)` are pure sends with zero type-switching in SX.
|
||||||
|
Lists/headings render in Smalltalk source. No HTML escaping yet (noted in
|
||||||
|
render.sx — boundary concern before untrusted content). 29 tests; suite
|
||||||
|
107/107.
|
||||||
- 2026-06-06 — Phase 1 `doc.sx`: ordered block document (`CtDoc`) as a
|
- 2026-06-06 — Phase 1 `doc.sx`: ordered block document (`CtDoc`) as a
|
||||||
Smalltalk object holding an ordered block sequence. Edit ops are data dicts
|
Smalltalk object holding an ordered block sequence. Edit ops are data dicts
|
||||||
(`insert`/`update`/`move`/`delete`) with `op-*` constructors; `doc-apply` /
|
(`insert`/`update`/`move`/`delete`) with `op-*` constructors; `doc-apply` /
|
||||||
|
|||||||
Reference in New Issue
Block a user