content: portable data serialization (data.sx) + 21 tests (523/523)
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 page page-full markdown text section compose stats table validate store snapshot crdt crdt-store sync md-import md-doc fed)
|
||||
SUITES=(block doc render api meta page page-full markdown text section compose stats table data validate store snapshot crdt crdt-store sync md-import md-doc fed)
|
||||
|
||||
OUT_JSON="lib/content/scoreboard.json"
|
||||
OUT_MD="lib/content/scoreboard.md"
|
||||
@@ -48,6 +48,7 @@ run_suite() {
|
||||
(load "lib/content/compose.sx")
|
||||
(load "lib/content/stats.sx")
|
||||
(load "lib/content/table.sx")
|
||||
(load "lib/content/data.sx")
|
||||
(load "lib/content/page.sx")
|
||||
(load "lib/content/page-full.sx")
|
||||
(load "lib/content/markdown.sx")
|
||||
|
||||
79
lib/content/data.sx
Normal file
79
lib/content/data.sx
Normal file
@@ -0,0 +1,79 @@
|
||||
;; content-on-sx — portable data serialization.
|
||||
;;
|
||||
;; Converts documents to/from a plain SX data form, decoupling storage and
|
||||
;; transport from the Smalltalk instance shape. A document becomes
|
||||
;; {:id :title :slug :tags :blocks (list block-data)}
|
||||
;; and a block becomes {:id :type :fields {...}} (section children recurse).
|
||||
;; content/from-data reconstructs real block objects.
|
||||
;;
|
||||
;; Requires (loaded by harness): block.sx, doc.sx, meta.sx, section.sx
|
||||
;; (mk-section), table.sx (mk-table).
|
||||
|
||||
;; ── to-data ──
|
||||
(define
|
||||
content/-fd-loop
|
||||
(fn
|
||||
(ks ivs acc)
|
||||
(if
|
||||
(= (len ks) 0)
|
||||
acc
|
||||
(let
|
||||
((k (first ks)))
|
||||
(if
|
||||
(= k "id")
|
||||
(content/-fd-loop (rest ks) ivs acc)
|
||||
(content/-fd-loop
|
||||
(rest ks)
|
||||
ivs
|
||||
(assoc
|
||||
acc
|
||||
k
|
||||
(if
|
||||
(= k "children")
|
||||
(map block->data (get ivs k))
|
||||
(get ivs k)))))))))
|
||||
|
||||
(define block->data (fn (b) {:fields (content/-fd-loop (keys (get b :ivars)) (get b :ivars) {}) :id (blk-id b) :type (blk-type b)}))
|
||||
|
||||
(define content/to-data (fn (doc) {:blocks (map block->data (doc-blocks doc)) :slug (doc-slug doc) :id (doc-id doc) :title (doc-title doc) :tags (doc-tags doc)}))
|
||||
|
||||
;; ── from-data ──
|
||||
(define
|
||||
content/-field-pairs
|
||||
(fn (fields) (map (fn (k) (list k (get fields k))) (keys fields))))
|
||||
|
||||
(define
|
||||
data->block
|
||||
(fn
|
||||
(d)
|
||||
(let
|
||||
((type (get d :type)) (id (get d :id)) (fields (get d :fields)))
|
||||
(cond
|
||||
((= type "section")
|
||||
(mk-section id (map data->block (get fields "children"))))
|
||||
((= type "table")
|
||||
(mk-table id (get fields "headers") (get fields "rows")))
|
||||
(else (mk-block type id (content/-field-pairs fields)))))))
|
||||
|
||||
(define
|
||||
content/-meta-of
|
||||
(fn
|
||||
(data)
|
||||
(let
|
||||
((m1 (if (= (get data :title) nil) {} (assoc {} :title (get data :title)))))
|
||||
(let
|
||||
((m2 (if (= (get data :slug) nil) m1 (assoc m1 :slug (get data :slug)))))
|
||||
(let
|
||||
((tags (get data :tags)))
|
||||
(if
|
||||
(or (= tags nil) (= (len tags) 0))
|
||||
m2
|
||||
(assoc m2 :tags tags)))))))
|
||||
|
||||
(define
|
||||
content/from-data
|
||||
(fn
|
||||
(data)
|
||||
(doc-with-meta
|
||||
(doc-new (get data :id) (map data->block (get data :blocks)))
|
||||
(content/-meta-of data))))
|
||||
@@ -13,6 +13,7 @@
|
||||
"compose": {"pass": 17, "fail": 0},
|
||||
"stats": {"pass": 17, "fail": 0},
|
||||
"table": {"pass": 15, "fail": 0},
|
||||
"data": {"pass": 21, "fail": 0},
|
||||
"validate": {"pass": 23, "fail": 0},
|
||||
"store": {"pass": 29, "fail": 0},
|
||||
"snapshot": {"pass": 20, "fail": 0},
|
||||
@@ -23,7 +24,7 @@
|
||||
"md-doc": {"pass": 12, "fail": 0},
|
||||
"fed": {"pass": 20, "fail": 0}
|
||||
},
|
||||
"total_pass": 502,
|
||||
"total_pass": 523,
|
||||
"total_fail": 0,
|
||||
"total": 502
|
||||
"total": 523
|
||||
}
|
||||
|
||||
@@ -17,6 +17,7 @@ _Generated by `lib/content/conformance.sh`_
|
||||
| compose | 17 | 0 | 17 |
|
||||
| stats | 17 | 0 | 17 |
|
||||
| table | 15 | 0 | 15 |
|
||||
| data | 21 | 0 | 21 |
|
||||
| validate | 23 | 0 | 23 |
|
||||
| store | 29 | 0 | 29 |
|
||||
| snapshot | 20 | 0 | 20 |
|
||||
@@ -26,4 +27,4 @@ _Generated by `lib/content/conformance.sh`_
|
||||
| md-import | 38 | 0 | 38 |
|
||||
| md-doc | 12 | 0 | 12 |
|
||||
| fed | 20 | 0 | 20 |
|
||||
| **Total** | **502** | **0** | **502** |
|
||||
| **Total** | **523** | **0** | **523** |
|
||||
|
||||
93
lib/content/tests/data.sx
Normal file
93
lib/content/tests/data.sx
Normal file
@@ -0,0 +1,93 @@
|
||||
;; Extension — portable data serialization (to-data / from-data round-trip).
|
||||
|
||||
(st-bootstrap-classes!)
|
||||
(content/bootstrap!)
|
||||
(content-bootstrap-text!)
|
||||
(content-bootstrap-markdown!)
|
||||
(content-bootstrap-section!)
|
||||
(content-bootstrap-table!)
|
||||
|
||||
;; ── block->data shape ──
|
||||
(define h (mk-heading "h" 2 "Hi"))
|
||||
(content-test "block->data id" (get (block->data h) :id) "h")
|
||||
(content-test "block->data type" (get (block->data h) :type) "heading")
|
||||
(content-test "block->data fields" (get (block->data h) :fields) {:text "Hi" :level 2})
|
||||
|
||||
;; ── round-trip a mixed document with metadata ──
|
||||
(define
|
||||
d
|
||||
(doc-with-meta
|
||||
(doc-append
|
||||
(doc-append
|
||||
(doc-append
|
||||
(doc-append (doc-empty "post") (mk-heading "h" 1 "Title"))
|
||||
(mk-text "p" "Body"))
|
||||
(mk-image "img" "/c.png" "cat"))
|
||||
(mk-list "l" true (list "a" "b")))
|
||||
{:slug "s" :title "T" :tags (list "x" "y")}))
|
||||
|
||||
(define rt (content/from-data (content/to-data d)))
|
||||
(content-test "rt id" (doc-id rt) "post")
|
||||
(content-test "rt title" (doc-title rt) "T")
|
||||
(content-test "rt slug" (doc-slug rt) "s")
|
||||
(content-test "rt tags" (doc-tags rt) (list "x" "y"))
|
||||
(content-test "rt ids" (doc-ids rt) (list "h" "p" "img" "l"))
|
||||
(content-test "rt render" (asHTML rt) (asHTML d))
|
||||
(content-test
|
||||
"rt heading level"
|
||||
(blk-send (doc-find rt "h") "level")
|
||||
1)
|
||||
(content-test
|
||||
"rt list items"
|
||||
(blk-send (doc-find rt "l") "items")
|
||||
(list "a" "b"))
|
||||
|
||||
;; ── nested sections round-trip ──
|
||||
(define
|
||||
ds
|
||||
(doc-append
|
||||
(doc-empty "d")
|
||||
(mk-section
|
||||
"s"
|
||||
(list
|
||||
(mk-heading "nh" 2 "N")
|
||||
(mk-section "i" (list (mk-text "x" "deep")))))))
|
||||
(define rts (content/from-data (content/to-data ds)))
|
||||
(content-test "rt nested render" (asHTML rts) (asHTML ds))
|
||||
(content-test "rt nested tree-ids" (doc-tree-ids rts) (doc-tree-ids ds))
|
||||
(content-test
|
||||
"rt nested deep-find"
|
||||
(str (blk-send (doc-deep-find rts "x") "text"))
|
||||
"deep")
|
||||
|
||||
;; ── table round-trip ──
|
||||
(define
|
||||
dtb
|
||||
(doc-append
|
||||
(doc-empty "d")
|
||||
(mk-table "t" (list "A" "B") (list (list "1" "2")))))
|
||||
(define rtt (content/from-data (content/to-data dtb)))
|
||||
(content-test "rt table render" (asHTML rtt) (asHTML dtb))
|
||||
(content-test
|
||||
"rt table headers"
|
||||
(table-headers (doc-find rtt "t"))
|
||||
(list "A" "B"))
|
||||
|
||||
;; ── data is plain (no st-instance markers at top level) ──
|
||||
(define dat (content/to-data d))
|
||||
(content-test "data id field" (get dat :id) "post")
|
||||
(content-test "data block count" (len (get dat :blocks)) 4)
|
||||
(content-test
|
||||
"data first block type"
|
||||
(get (first (get dat :blocks)) :type)
|
||||
"heading")
|
||||
|
||||
;; ── empty doc round-trip ──
|
||||
(content-test
|
||||
"rt empty ids"
|
||||
(doc-ids (content/from-data (content/to-data (doc-empty "e"))))
|
||||
(list))
|
||||
(content-test
|
||||
"rt no-meta title nil"
|
||||
(doc-title (content/from-data (content/to-data (doc-empty "e"))))
|
||||
nil)
|
||||
Reference in New Issue
Block a user