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>
48 lines
1.9 KiB
Plaintext
48 lines
1.9 KiB
Plaintext
;; content-on-sx — make a document render-safe by dropping invalid blocks.
|
|
;;
|
|
;; The enforcement counterpart to validate: where content/validate REPORTS id /
|
|
;; field issues, content/sanitize REMOVES the offending blocks so the result can
|
|
;; be rendered/merged without faulting on malformed input (federated or imported
|
|
;; documents that failed validation). Tree-wide: descends into sections, pruning
|
|
;; invalid descendants; a section whose own shell is valid is kept (even if it
|
|
;; ends up empty — that is normalize's job, not sanitize's), but a section whose
|
|
;; own check fails (e.g. children is not a list) is dropped whole.
|
|
;;
|
|
;; Reuses validate's per-block predicate (content/-block-issues), so the set of
|
|
;; "what is invalid" stays single-sourced and can't drift from content/validate.
|
|
;; sanitize addresses per-block id/field validity only; it does NOT resolve
|
|
;; duplicate ids (a cross-block concern with no single right answer), so a
|
|
;; sanitized doc is render-safe but not necessarily content/valid? if the input
|
|
;; carried duplicate ids. Immutable; returns a new document.
|
|
;;
|
|
;; Requires (loaded by harness): block.sx, doc.sx, validate.sx
|
|
;; (content/-block-issues).
|
|
|
|
(define
|
|
san-section?
|
|
(fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
|
|
|
|
;; a block is render-safe when it has no id/field issues (validate's own checks)
|
|
(define san-ok? (fn (b) (= (len (content/-block-issues b)) 0)))
|
|
|
|
;; drop invalid blocks at this level; recurse into surviving sections so invalid
|
|
;; descendants are pruned too.
|
|
(define
|
|
san-blocks
|
|
(fn
|
|
(blocks)
|
|
(map
|
|
(fn
|
|
(b)
|
|
(if
|
|
(san-section? b)
|
|
(let
|
|
((ch (st-iv-get b "children")))
|
|
(if (list? ch) (st-iv-set! b "children" (san-blocks ch)) b))
|
|
b))
|
|
(filter san-ok? blocks))))
|
|
|
|
(define
|
|
content/sanitize
|
|
(fn (doc) (doc-with-blocks doc (san-blocks (doc-blocks doc)))))
|