content: relative block reorder (move.sx) + 11 tests (668/668)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-06-07 05:04:45 +00:00
parent c0ca2509d0
commit 715dbe248f
6 changed files with 146 additions and 5 deletions

View File

@@ -15,7 +15,7 @@ if [ ! -x "$SX_SERVER" ]; then
fi
fi
SUITES=(block doc render api meta page page-full markdown text section compose tree-edit clone query toc anchor outline flatten transform normalize find-replace stats table callout data wire 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 tree-edit move clone query toc anchor outline flatten transform normalize find-replace stats table callout data wire validate store snapshot crdt crdt-store sync md-import md-doc fed)
OUT_JSON="lib/content/scoreboard.json"
OUT_MD="lib/content/scoreboard.md"
@@ -47,6 +47,7 @@ run_suite() {
(load "lib/content/section.sx")
(load "lib/content/compose.sx")
(load "lib/content/tree-edit.sx")
(load "lib/content/move.sx")
(load "lib/content/clone.sx")
(load "lib/content/query.sx")
(load "lib/content/toc.sx")

69
lib/content/move.sx Normal file
View File

@@ -0,0 +1,69 @@
;; content-on-sx — relative block reorder.
;;
;; Move a top-level block to just before / after another block by id — more
;; ergonomic than the index-based doc-move. No-op if either id is missing.
;; Immutable; composes the doc.sx list helpers.
;;
;; Requires (loaded by harness): doc.sx.
(define
content/move-before
(fn
(doc id target)
(let
((blk (doc-find doc id)))
(if
(= blk nil)
doc
(let
((without (ct-remove-id (doc-blocks doc) id)))
(let
((idx (ct-index-of without target)))
(if
(= idx -1)
doc
(doc-with-blocks doc (ct-insert-at without idx blk)))))))))
(define
content/move-after
(fn
(doc id target)
(let
((blk (doc-find doc id)))
(if
(= blk nil)
doc
(let
((without (ct-remove-id (doc-blocks doc) id)))
(let
((idx (ct-index-of without target)))
(if
(= idx -1)
doc
(doc-with-blocks
doc
(ct-insert-at without (+ idx 1) blk)))))))))
(define
content/move-to-front
(fn
(doc id)
(let
((blk (doc-find doc id)))
(if
(= blk nil)
doc
(doc-with-blocks doc (cons blk (ct-remove-id (doc-blocks doc) id)))))))
(define
content/move-to-back
(fn
(doc id)
(let
((blk (doc-find doc id)))
(if
(= blk nil)
doc
(doc-with-blocks
doc
(append (ct-remove-id (doc-blocks doc) id) (list blk)))))))

View File

@@ -12,6 +12,7 @@
"section": {"pass": 25, "fail": 0},
"compose": {"pass": 17, "fail": 0},
"tree-edit": {"pass": 17, "fail": 0},
"move": {"pass": 11, "fail": 0},
"clone": {"pass": 10, "fail": 0},
"query": {"pass": 13, "fail": 0},
"toc": {"pass": 8, "fail": 0},
@@ -36,7 +37,7 @@
"md-doc": {"pass": 12, "fail": 0},
"fed": {"pass": 20, "fail": 0}
},
"total_pass": 657,
"total_pass": 668,
"total_fail": 0,
"total": 657
"total": 668
}

View File

@@ -16,6 +16,7 @@ _Generated by `lib/content/conformance.sh`_
| section | 25 | 0 | 25 |
| compose | 17 | 0 | 17 |
| tree-edit | 17 | 0 | 17 |
| move | 11 | 0 | 11 |
| clone | 10 | 0 | 10 |
| query | 13 | 0 | 13 |
| toc | 8 | 0 | 8 |
@@ -39,4 +40,4 @@ _Generated by `lib/content/conformance.sh`_
| md-import | 38 | 0 | 38 |
| md-doc | 12 | 0 | 12 |
| fed | 20 | 0 | 20 |
| **Total** | **657** | **0** | **657** |
| **Total** | **668** | **0** | **668** |

63
lib/content/tests/move.sx Normal file
View File

@@ -0,0 +1,63 @@
;; Extension — relative block reorder.
(st-bootstrap-classes!)
(content/bootstrap!)
(define
d
(doc-append
(doc-append
(doc-append (doc-empty "d") (mk-text "a" "A"))
(mk-text "b" "B"))
(mk-text "c" "C")))
;; ── move-before ──
(content-test
"move-before"
(doc-ids (content/move-before d "c" "a"))
(list "c" "a" "b"))
(content-test
"move-before mid"
(doc-ids (content/move-before d "c" "b"))
(list "a" "c" "b"))
(content-test "move-before immutable" (doc-ids d) (list "a" "b" "c"))
;; ── move-after ──
(content-test
"move-after"
(doc-ids (content/move-after d "a" "b"))
(list "b" "a" "c"))
(content-test
"move-after last"
(doc-ids (content/move-after d "a" "c"))
(list "b" "c" "a"))
;; ── move-to-front / back ──
(content-test
"move-to-front"
(doc-ids (content/move-to-front d "c"))
(list "c" "a" "b"))
(content-test
"move-to-back"
(doc-ids (content/move-to-back d "a"))
(list "b" "c" "a"))
(content-test
"front already first"
(doc-ids (content/move-to-front d "a"))
(list "a" "b" "c"))
;; ── no-ops ──
(content-test
"missing id no-op"
(doc-ids (content/move-before d "zzz" "a"))
(list "a" "b" "c"))
(content-test
"missing target no-op"
(doc-ids (content/move-before d "a" "zzz"))
(list "a" "b" "c"))
;; ── render after move ──
(content-test
"render after move"
(asHTML (content/move-after d "a" "c"))
"<p>B</p><p>C</p><p>A</p>")