content: document validation (validate.sx) + 17 tests (294/294)

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 01:25:37 +00:00
parent ef38b24110
commit 7836709f91
6 changed files with 288 additions and 5 deletions
--- a/lib/content/validate.sx
+++ b/lib/content/validate.sx
@@ -0,0 +1,156 @@
+;; content-on-sx — document integrity validation.
+;;
+;; Guards imports, edits and federated input: checks each block's id and the
+;; required fields/types for its kind, plus document-level duplicate ids. Returns
+;; a list of issue dicts {:id :kind :detail}; an empty list means valid. Dispatch
+;; on block type is a validation-boundary concern, not core behaviour.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx.
+
+(define ct-issue (fn (id kind detail) {:id id :detail detail :kind kind}))
+
+(define
+  ct-flatmap
+  (fn
+    (f xs)
+    (if
+      (= (len xs) 0)
+      (list)
+      (append (f (first xs)) (ct-flatmap f (rest xs))))))
+
+(define ct-count-in (fn (x xs) (len (filter (fn (y) (= y x)) xs))))
+
+;; dedup, order-preserving (keep first occurrence)
+(define
+  ct-uniq-loop
+  (fn
+    (xs seen)
+    (if
+      (= (len xs) 0)
+      (reverse seen)
+      (if
+        (> (ct-count-in (first xs) seen) 0)
+        (ct-uniq-loop (rest xs) seen)
+        (ct-uniq-loop (rest xs) (cons (first xs) seen))))))
+
+(define ct-uniq (fn (xs) (ct-uniq-loop xs (list))))
+
+;; ── id checks ──
+(define
+  content/-id-issues
+  (fn
+    (b)
+    (let
+      ((id (blk-id b)))
+      (if
+        (and (string? id) (> (len id) 0))
+        (list)
+        (list (ct-issue id "id" "block id must be a non-empty string"))))))
+
+(define
+  ct-field-issue
+  (fn (id ok? what) (if ok? (list) (list (ct-issue id "field" what)))))
+
+;; ── per-type field checks ──
+(define
+  content/-field-issues
+  (fn
+    (b)
+    (let
+      ((t (blk-type b)) (id (blk-id b)))
+      (cond
+        ((= t "heading")
+          (append
+            (ct-field-issue
+              id
+              (number? (blk-get b "level"))
+              "heading level must be a number")
+            (ct-field-issue
+              id
+              (string? (blk-get b "text"))
+              "heading text must be a string")))
+        ((= t "text")
+          (ct-field-issue
+            id
+            (string? (blk-get b "text"))
+            "text must be a string"))
+        ((= t "code")
+          (append
+            (ct-field-issue
+              id
+              (string? (blk-get b "language"))
+              "code language must be a string")
+            (ct-field-issue
+              id
+              (string? (blk-get b "text"))
+              "code text must be a string")))
+        ((= t "quote")
+          (ct-field-issue
+            id
+            (string? (blk-get b "text"))
+            "quote text must be a string"))
+        ((= t "image")
+          (append
+            (ct-field-issue
+              id
+              (string? (blk-get b "src"))
+              "image src must be a string")
+            (ct-field-issue
+              id
+              (string? (blk-get b "alt"))
+              "image alt must be a string")))
+        ((= t "embed")
+          (append
+            (ct-field-issue
+              id
+              (string? (blk-get b "url"))
+              "embed url must be a string")
+            (ct-field-issue
+              id
+              (string? (blk-get b "provider"))
+              "embed provider must be a string")))
+        ((= t "divider") (list))
+        ((= t "list")
+          (append
+            (ct-field-issue
+              id
+              (boolean? (blk-get b "ordered"))
+              "list ordered must be a boolean")
+            (ct-field-issue
+              id
+              (list? (blk-get b "items"))
+              "list items must be a list")))
+        (else (list (ct-issue id "type" (str "unknown block type: " t))))))))
+
+(define
+  content/-block-issues
+  (fn (b) (append (content/-id-issues b) (content/-field-issues b))))
+
+;; ── document-level: duplicate ids ──
+(define
+  content/-dup-issues
+  (fn
+    (doc)
+    (let
+      ((ids (doc-ids doc)))
+      (map
+        (fn (id) (ct-issue id "duplicate" (str "duplicate block id: " id)))
+        (ct-uniq
+          (filter (fn (id) (> (ct-count-in id ids) 1)) ids))))))
+
+;; ── public ──
+(define
+  content/validate
+  (fn
+    (doc)
+    (append
+      (content/-dup-issues doc)
+      (ct-flatmap content/-block-issues (doc-blocks doc)))))
+
+(define
+  content/valid?
+  (fn (doc) (= (len (content/validate doc)) 0)))
+
+(define
+  content/issue-kinds
+  (fn (doc) (map (fn (i) (get i :kind)) (content/validate doc))))