rose-ash/lib/content/tests/crdt-tree.sx

;; Extension — nested-tree CvRDT. Sections nest and merge collaboratively;
;; convergence is order/replica/duplicate-insensitive like the flat layer.

(st-bootstrap-classes!)
(content-bootstrap-blocks!)
(content-bootstrap-doc!)
(content-bootstrap-render!)
(content-bootstrap-section!)

(define same? (fn (a b) (= (get a :elements) (get b :elements))))

;; base: a section "s" at root, with one child heading.
(define
  base
  (crdt-tree-insert
    (crdt-tree-insert
      (crdt-empty)
      "s"
      "section"
      (crdt-pos 1 0)
      ""
      (list)
      1
      0)
    "h"
    "heading"
    (crdt-pos 1 0)
    "s"
    (list (list "level" 2) (list "text" "Sub"))
    1
    0))

;; ── materialise rebuilds the tree ──
(content-test "tree order root" (crdt-tree-order base) (list "s"))
(content-test
  "tree materialize ids"
  (doc-tree-ids (crdt-tree-materialize "d" base))
  (list "s" "h"))
(content-test
  "tree render"
  (asHTML (crdt-tree-materialize "d" base))
  "<section><h2>Sub</h2></section>")

;; ── concurrent inserts into the SAME section converge + order by pos ──
(define
  rA
  (crdt-tree-insert
    base
    "a"
    "text"
    (crdt-pos 5 1)
    "s"
    (list (list "text" "A"))
    2
    1))
(define
  rB
  (crdt-tree-insert
    base
    "b"
    "text"
    (crdt-pos 5 2)
    "s"
    (list (list "text" "B"))
    2
    2))
(content-test
  "same-parent merge commutes"
  (same? (crdt-tree-merge rA rB) (crdt-tree-merge rB rA))
  true)
(content-test
  "same-parent order deterministic"
  (doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-merge rA rB)))
  (list "s" "h" "a" "b"))

;; ── concurrent inserts into DIFFERENT parents converge ──
(define
  base2
  (crdt-tree-insert
    (crdt-tree-insert
      (crdt-empty)
      "s1"
      "section"
      (crdt-pos 1 0)
      ""
      (list)
      1
      0)
    "s2"
    "section"
    (crdt-pos 2 0)
    ""
    (list)
    1
    0))
(define
  x
  (crdt-tree-insert
    base2
    "x"
    "text"
    (crdt-pos 1 0)
    "s1"
    (list (list "text" "X"))
    2
    1))
(define
  y
  (crdt-tree-insert
    base2
    "y"
    "text"
    (crdt-pos 1 0)
    "s2"
    (list (list "text" "Y"))
    2
    2))
(define m (crdt-tree-merge x y))
(content-test
  "different-parent commutes"
  (same? m (crdt-tree-merge y x))
  true)
(content-test
  "different-parent tree"
  (doc-tree-ids (crdt-tree-materialize "d" m))
  (list "s1" "x" "s2" "y"))
(content-test
  "different-parent render"
  (asHTML (crdt-tree-materialize "d" m))
  "<section><p>X</p></section><section><p>Y</p></section>")

;; ── nested sections (section inside section) ──
(define
  nested
  (crdt-tree-apply-all
    (crdt-empty)
    (list
      (crdt-tree-op-insert
        "outer"
        "section"
        (crdt-pos 1 0)
        ""
        (list)
        1
        0)
      (crdt-tree-op-insert
        "inner"
        "section"
        (crdt-pos 1 0)
        "outer"
        (list)
        1
        0)
      (crdt-tree-op-insert
        "leaf"
        "text"
        (crdt-pos 1 0)
        "inner"
        (list (list "text" "deep"))
        1
        0))))
(content-test
  "nested tree ids"
  (doc-tree-ids (crdt-tree-materialize "d" nested))
  (list "outer" "inner" "leaf"))
(content-test
  "nested render"
  (asHTML (crdt-tree-materialize "d" nested))
  "<section><section><p>deep</p></section></section>")

;; ── ops in any order converge (commutative) ──
(define
  opA
  (crdt-tree-op-insert
    "p"
    "text"
    (crdt-pos 6 0)
    "s"
    (list (list "text" "P"))
    3
    1))
(define opB (crdt-tree-op-update "h" "text" "Edited" 5 1))
(define opC (crdt-tree-op-delete "h"))
(content-test
  "ops commute"
  (same?
    (crdt-tree-apply-all base (list opA opB opC))
    (crdt-tree-apply-all base (list opC opB opA)))
  true)
(content-test
  "ops idempotent"
  (same?
    (crdt-tree-apply-all base (list opA opB))
    (crdt-tree-apply-all
      (crdt-tree-apply-all base (list opA opB))
      (list opA opB)))
  true)

;; ── update into a section + LWW ──
(define u1 (crdt-tree-update base "h" "text" "v5" 5 1))
(define u2 (crdt-tree-update base "h" "text" "v7" 7 2))
(content-test
  "tree LWW higher ts"
  (str
    (blk-send
      (doc-deep-find (crdt-tree-materialize "d" (crdt-tree-merge u1 u2)) "h")
      "text"))
  "v7")

;; ── delete inside a section ──
(content-test
  "delete in section"
  (doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-delete base "h")))
  (list "s"))

;; ── merge idempotence ──
(content-test "merge idempotent self" (same? (crdt-tree-merge m m) m) true)

;; ── full convergence: two replicas, divergent edits in different sections ──
(define
  repl1
  (crdt-tree-apply-all
    base2
    (list
      (crdt-tree-op-insert
        "p1"
        "text"
        (crdt-pos 1 0)
        "s1"
        (list (list "text" "from1"))
        5
        1))))
(define
  repl2
  (crdt-tree-apply-all
    base2
    (list
      (crdt-tree-op-insert
        "p2"
        "text"
        (crdt-pos 1 0)
        "s2"
        (list (list "text" "from2"))
        6
        2))))
(content-test
  "two-replica tree converges"
  (same? (crdt-tree-merge repl1 repl2) (crdt-tree-merge repl2 repl1))
  true)
(content-test
  "two-replica tree ids"
  (doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-merge repl1 repl2)))
  (list "s1" "p1" "s2" "p2"))

;; ── orphan reparenting: concurrent delete-section + insert-child ──
;; A deletes section s; B inserts a child into s. After merge, s is gone but the
;; child must survive (reparented to root), not silently vanish.
(define delA (crdt-tree-delete base "s"))
(define
  insB
  (crdt-tree-insert
    base
    "c"
    "text"
    (crdt-pos 9 0)
    "s"
    (list (list "text" "kept"))
    5
    2))
(define orphan-merge (crdt-tree-merge delA insB))
(content-test
  "orphan survives delete-section"
  (doc-tree-ids (crdt-tree-materialize "d" orphan-merge))
  (list "h" "c"))
(content-test
  "orphan reparent commutes"
  (same? orphan-merge (crdt-tree-merge insB delA))
  true)
(content-test
  "orphan content preserved"
  (str
    (blk-send
      (doc-deep-find (crdt-tree-materialize "d" orphan-merge) "c")
      "text"))
  "kept")
(content-test
  "orphan render at root"
  (asHTML (crdt-tree-materialize "d" orphan-merge))
  "<h2>Sub</h2><p>kept</p>")