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

;; Phase 3 — collaborative merge (CvRDT). The merge is a join: commutative,
;; associative, idempotent. Tests apply ops in any order, twice, and merge
;; replicas both ways — all must converge to identical state.

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

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

;; ── position order (Logoot) ──
(content-test
  "pos lt"
  (crdt-pos-compare
    (crdt-pos 1 0)
    (crdt-pos 2 0))
  -1)
(content-test
  "pos gt"
  (crdt-pos-compare
    (crdt-pos 2 0)
    (crdt-pos 1 0))
  1)
(content-test
  "pos eq"
  (crdt-pos-compare
    (crdt-pos 1 0)
    (crdt-pos 1 0))
  0)
(content-test
  "pos actor tiebreak"
  (crdt-pos-compare
    (crdt-pos 1 1)
    (crdt-pos 1 2))
  -1)
(content-test
  "between > left"
  (<
    (crdt-pos-compare
      (crdt-pos 1 0)
      (crdt-pos-between
        (crdt-pos 1 0)
        (crdt-pos 2 0)
        9))
    0)
  true)
(content-test
  "between < right"
  (<
    (crdt-pos-compare
      (crdt-pos-between
        (crdt-pos 1 0)
        (crdt-pos 2 0)
        9)
      (crdt-pos 2 0))
    0)
  true)
(content-test
  "between start < right"
  (<
    (crdt-pos-compare
      (crdt-pos-between nil (crdt-pos 5 0) 9)
      (crdt-pos 5 0))
    0)
  true)
(content-test
  "between end > left"
  (<
    (crdt-pos-compare
      (crdt-pos 5 0)
      (crdt-pos-between (crdt-pos 5 0) nil 9))
    0)
  true)

;; ── build + materialise ──
(define
  base
  (crdt-insert
    (crdt-insert
      (crdt-empty)
      "h"
      "heading"
      (crdt-pos 1 0)
      (list (list "level" 1) (list "text" "Title"))
      1
      0)
    "p"
    "text"
    (crdt-pos 2 0)
    (list (list "text" "Body"))
    1
    0))

(content-test "order" (crdt-order base) (list "h" "p"))
(content-test
  "materialize ids"
  (doc-ids (crdt-materialize "d" base))
  (list "h" "p"))
(content-test
  "materialize render"
  (asHTML (crdt-materialize "d" base))
  "<h1>Title</h1><p>Body</p>")

;; ── commutativity: ops in any order converge ──
(define
  opA
  (crdt-op-insert
    "x"
    "text"
    (crdt-pos 3 0)
    (list (list "text" "X"))
    2
    1))
(define opB (crdt-op-update "p" "text" "Edited" 5 1))
(define opC (crdt-op-delete "h"))
(define s-abc (crdt-apply-all base (list opA opB opC)))
(define s-cba (crdt-apply-all base (list opC opB opA)))
(define s-bca (crdt-apply-all base (list opB opC opA)))
(content-test "commutative abc=cba" (same? s-abc s-cba) true)
(content-test "commutative abc=bca" (same? s-abc s-bca) true)
(content-test "commutative result order" (crdt-order s-abc) (list "p" "x"))

;; ── idempotence: applying ops twice changes nothing ──
(content-test
  "idempotent ops"
  (same? s-abc (crdt-apply-all s-abc (list opA opB opC)))
  true)

;; ── update-before-insert is not lost ──
(define
  ub
  (crdt-apply-all
    (crdt-empty)
    (list
      (crdt-op-update "z" "text" "late" 3 1)
      (crdt-op-insert
        "z"
        "text"
        (crdt-pos 1 0)
        (list (list "text" "orig"))
        1
        1))))
(content-test
  "update before insert kept"
  (str (blk-send (doc-find (crdt-materialize "d" ub) "z") "text"))
  "late")

;; ── delete-before-insert: remove-wins ──
(define
  db
  (crdt-apply-all
    (crdt-empty)
    (list
      (crdt-op-delete "k")
      (crdt-op-insert
        "k"
        "text"
        (crdt-pos 1 0)
        (list (list "text" "x"))
        1
        1))))
(content-test "delete before insert removes" (crdt-order db) (list))

;; ── concurrent inserts converge + deterministic order ──
(define
  rA
  (crdt-insert
    base
    "a1"
    "text"
    (crdt-pos 5 1)
    (list (list "text" "A"))
    2
    1))
(define
  rB
  (crdt-insert
    base
    "b1"
    "text"
    (crdt-pos 5 2)
    (list (list "text" "B"))
    2
    2))
(content-test
  "merge commutes"
  (same? (crdt-merge rA rB) (crdt-merge rB rA))
  true)
(content-test
  "merge order deterministic AB"
  (crdt-order (crdt-merge rA rB))
  (list "h" "p" "a1" "b1"))
(content-test
  "merge order deterministic BA"
  (crdt-order (crdt-merge rB rA))
  (list "h" "p" "a1" "b1"))

;; ── merge idempotence ──
(define mAB (crdt-merge rA rB))
(content-test "merge idempotent self" (same? (crdt-merge mAB mAB) mAB) true)
(content-test
  "merge idempotent remerge"
  (same? (crdt-merge mAB rA) mAB)
  true)

;; ── concurrent same-field update: LWW by (ts, actor) ──
(define u1 (crdt-update base "p" "text" "v-ts5" 5 1))
(define u2 (crdt-update base "p" "text" "v-ts7" 7 2))
(content-test
  "LWW higher ts wins"
  (str
    (blk-send
      (doc-find (crdt-materialize "d" (crdt-merge u1 u2)) "p")
      "text"))
  "v-ts7")
(content-test
  "LWW commutes"
  (same? (crdt-merge u1 u2) (crdt-merge u2 u1))
  true)
(define t1 (crdt-update base "p" "text" "actor1" 9 1))
(define t2 (crdt-update base "p" "text" "actor2" 9 2))
(content-test
  "LWW tie -> actor wins"
  (str
    (blk-send
      (doc-find (crdt-materialize "d" (crdt-merge t1 t2)) "p")
      "text"))
  "actor2")

;; ── concurrent disjoint-field updates both survive ──
(define f1 (crdt-update base "h" "text" "NewTitle" 5 1))
(define f2 (crdt-update base "h" "level" 3 5 2))
(define fm (crdt-merge f1 f2))
(content-test
  "disjoint field text"
  (str (blk-send (doc-find (crdt-materialize "d" fm) "h") "text"))
  "NewTitle")
(content-test
  "disjoint field level"
  (blk-send (doc-find (crdt-materialize "d" fm) "h") "level")
  3)
(content-test "disjoint commutes" (same? fm (crdt-merge f2 f1)) true)

;; ── associativity ──
(define c1 (crdt-update base "p" "text" "c1" 4 1))
(define
  c2
  (crdt-insert
    base
    "n2"
    "text"
    (crdt-pos 6 0)
    (list (list "text" "N"))
    2
    2))
(define c3 (crdt-delete base "h"))
(content-test
  "associative"
  (same?
    (crdt-merge (crdt-merge c1 c2) c3)
    (crdt-merge c1 (crdt-merge c2 c3)))
  true)
(content-test
  "merge-all = fold"
  (same?
    (crdt-merge-all (list c1 c2 c3))
    (crdt-merge c1 (crdt-merge c2 c3)))
  true)

;; ── full convergence: two replicas, divergent edits, merge both ways ──
(define
  repl-1
  (crdt-apply-all
    base
    (list
      (crdt-op-update "p" "text" "from-1" 5 1)
      (crdt-op-insert
        "img"
        "image"
        (crdt-pos-between
          (crdt-pos 1 0)
          (crdt-pos 2 0)
          1)
        (list (list "src" "/a.png") (list "alt" "a"))
        6
        1))))
(define
  repl-2
  (crdt-apply-all
    base
    (list
      (crdt-op-delete "h")
      (crdt-op-update "p" "text" "from-2" 7 2))))
(content-test
  "two-replica converges"
  (same? (crdt-merge repl-1 repl-2) (crdt-merge repl-2 repl-1))
  true)
(content-test
  "two-replica result order"
  (crdt-order (crdt-merge repl-1 repl-2))
  (list "img" "p"))
(content-test
  "two-replica LWW field"
  (str
    (blk-send
      (doc-find (crdt-materialize "d" (crdt-merge repl-1 repl-2)) "p")
      "text"))
  "from-2")
(content-test
  "two-replica idempotent"
  (same?
    (crdt-merge (crdt-merge repl-1 repl-2) repl-1)
    (crdt-merge repl-1 repl-2))
  true)