giles
526838f320
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
117 lines
3.4 KiB
Plaintext
117 lines
3.4 KiB
Plaintext
;; 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!)
|
|
(content-bootstrap-callout!)
|
|
(content-bootstrap-media!)
|
|
|
|
;; ── 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"))
|
|
|
|
;; ── callout + media round-trip (regression: ct-class-for-type must know them) ──
|
|
(define
|
|
dcm
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-callout "co" "warning" "careful"))
|
|
(mk-video "vid" "/clip.mp4")))
|
|
(define rtcm (content/from-data (content/to-data dcm)))
|
|
(content-test "rt callout+media render" (asHTML rtcm) (asHTML dcm))
|
|
(content-test
|
|
"rt callout kind"
|
|
(str (blk-send (doc-find rtcm "co") "kind"))
|
|
"warning")
|
|
(content-test
|
|
"rt media kind"
|
|
(str (blk-send (doc-find rtcm "vid") "kind"))
|
|
"video")
|
|
(content-test
|
|
"rt callout+media types"
|
|
(doc-types rtcm)
|
|
(list "callout" "media"))
|
|
|
|
;; ── 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)
|