giles
29954689bc
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
Enforcement counterpart to validate: removes blocks failing validate's own per-block id/field checks (reused via content/-block-issues, single-sourced) so federated/imported input can render safely. Tree-wide; distinct from normalize (empty vs invalid); keeps valid-shell sections, drops invalid ones. New suite +12 tests (42 suites total). Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
129 lines
3.6 KiB
Plaintext
129 lines
3.6 KiB
Plaintext
;; Extension — make a document render-safe by dropping invalid blocks.
|
|
;; Counterpart to validate; reuses its per-block checks. Tree-wide.
|
|
|
|
(st-bootstrap-classes!)
|
|
(content-bootstrap-blocks!)
|
|
(content-bootstrap-doc!)
|
|
(content-bootstrap-section!)
|
|
|
|
;; ── a valid document is returned unchanged (same ids, tree order) ──
|
|
(define
|
|
good
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-heading "h" 1 "Title"))
|
|
(mk-text "p" "Body")))
|
|
(content-test
|
|
"valid doc keeps all blocks"
|
|
(doc-ids (content/sanitize good))
|
|
(list "h" "p"))
|
|
(content-test
|
|
"valid doc still valid after sanitize"
|
|
(content/valid? (content/sanitize good))
|
|
true)
|
|
|
|
;; ── a block with a bad field is dropped ──
|
|
(content-test
|
|
"bad-field block dropped"
|
|
(doc-ids
|
|
(content/sanitize
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-text "ok" "fine"))
|
|
(mk-heading "bad" "notnum" "T"))))
|
|
(list "ok"))
|
|
|
|
;; ── unknown block type dropped ──
|
|
(define raw (st-iv-set! (st-make-instance "CtBlock") "id" "z"))
|
|
(content-test
|
|
"unknown-type block dropped"
|
|
(doc-ids
|
|
(content/sanitize
|
|
(doc-append (doc-append (doc-empty "d") (mk-text "ok" "x")) raw)))
|
|
(list "ok"))
|
|
|
|
;; ── blank-id block dropped ──
|
|
(content-test
|
|
"blank-id block dropped"
|
|
(doc-ids
|
|
(content/sanitize
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-text "ok" "x"))
|
|
(mk-text "" "y"))))
|
|
(list "ok"))
|
|
|
|
;; ── result is render-safe: no id/field issues remain ──
|
|
(content-test
|
|
"sanitized has no field/id issues"
|
|
(len
|
|
(filter
|
|
(fn (i) (if (= (get i :kind) "field") true (= (get i :kind) "id")))
|
|
(content/validate
|
|
(content/sanitize
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-text "ok" "x"))
|
|
(mk-heading "bad" "notnum" "T"))))))
|
|
0)
|
|
|
|
;; ── immutability: original document untouched ──
|
|
(define
|
|
withbad
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-text "ok" "x"))
|
|
(mk-heading "bad" "notnum" "T")))
|
|
(define _ (content/sanitize withbad))
|
|
(content-test "original unchanged" (doc-ids withbad) (list "ok" "bad"))
|
|
|
|
;; ── tree-wide: invalid nested child pruned, valid sibling + section kept ──
|
|
(define
|
|
nested
|
|
(doc-append
|
|
(doc-empty "d")
|
|
(mk-section
|
|
"s"
|
|
(list (mk-text "good" "keep") (mk-heading "badc" "notnum" "X")))))
|
|
(content-test
|
|
"invalid nested child pruned, section kept"
|
|
(doc-tree-ids (content/sanitize nested))
|
|
(list "s" "good"))
|
|
|
|
;; ── a section whose own shell is invalid (children not a list) is dropped ──
|
|
(define
|
|
badsec
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-text "ok" "x"))
|
|
(st-iv-set! (mk-section "s" (list)) "children" "nope")))
|
|
(content-test
|
|
"invalid section shell dropped whole"
|
|
(doc-tree-ids (content/sanitize badsec))
|
|
(list "ok"))
|
|
|
|
;; ── a valid section that loses all children is kept (empty) — sanitize is not
|
|
;; normalize; it removes invalid, not empty ──
|
|
(define
|
|
allbadchildren
|
|
(doc-append
|
|
(doc-empty "d")
|
|
(mk-section "s" (list (mk-heading "b1" "x" "X") (mk-text "" "y")))))
|
|
(content-test
|
|
"section kept though emptied of invalid children"
|
|
(doc-tree-ids (content/sanitize allbadchildren))
|
|
(list "s"))
|
|
|
|
;; ── deeply nested: invalid block two levels down is pruned ──
|
|
(define
|
|
deep
|
|
(doc-append
|
|
(doc-empty "d")
|
|
(mk-section
|
|
"o"
|
|
(list (mk-section "i" (list (mk-text "dok" "x") (mk-text "" "bad")))))))
|
|
(content-test
|
|
"deep invalid pruned"
|
|
(doc-tree-ids (content/sanitize deep))
|
|
(list "o" "i" "dok"))
|
|
|
|
;; ── empty document sanitizes to empty ──
|
|
(content-test
|
|
"empty doc stays empty"
|
|
(doc-ids (content/sanitize (doc-empty "e")))
|
|
(list))
|