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

;; content-on-sx — nested-tree CvRDT.
;;
;; Extends the flat CvRDT (crdt.sx) to a TREE: each element carries a `parent`
;; (the id of its containing section, "" = root) alongside its Logoot position.
;; Merge is still a join — it reuses crdt.sx's position/register/field merges and
;; adds parent (immutable, set once at insert). Materialisation rebuilds the
;; ordered tree: root = elements with parent "", a section's children = elements
;; whose parent is that section's id, each sorted by position. Commutative,
;; associative, idempotent like the flat layer; concurrent inserts into the same
;; or different parents converge deterministically.
;;
;; Requires (loaded by harness): crdt.sx (merge helpers + live/sort/materialise
;; bits), block.sx, doc.sx, section.sx (mk-section).

(define ctt-merge-parent (fn (p1 p2) (if (= p1 nil) p2 p1)))

(define ctt-merge-element (fn (e1 e2) {:fields (crdt-merge-fields (get e1 :fields) (get e2 :fields)) :parent (ctt-merge-parent (get e1 :parent) (get e2 :parent)) :id (get e1 :id) :type (crdt-merge-type (get e1 :type) (get e2 :type)) :deleted (or (= (get e1 :deleted) true) (= (get e2 :deleted) true)) :pos (crdt-merge-pos (get e1 :pos) (get e2 :pos))}))

(define
  ctt-add-element
  (fn
    (state elem)
    (let
      ((elems (get state :elements)) (id (get elem :id)))
      (let
        ((existing (get elems id)))
        (assoc
          state
          :elements (assoc
            elems
            id
            (if (= existing nil) elem (ctt-merge-element existing elem))))))))

;; ── ops as partial-element contributions ──
(define
  crdt-tree-insert
  (fn
    (state id type pos parent fields ts actor)
    (ctt-add-element state {:fields (crdt-build-fields fields ts actor) :parent parent :id id :type type :deleted false :pos pos})))

(define
  crdt-tree-update
  (fn (state id fname value ts actor) (ctt-add-element state {:fields (assoc {} fname {:ts ts :actor actor :value value}) :parent nil :id id :type nil :deleted false :pos nil})))

(define crdt-tree-delete (fn (state id) (ctt-add-element state {:fields {} :parent nil :id id :type nil :deleted true :pos nil})))

;; ── state merge (join) ──
(define
  ctt-merge-loop
  (fn
    (ids ea eb acc)
    (if
      (= (len ids) 0)
      acc
      (let
        ((id (first ids)))
        (let
          ((x (get ea id)) (y (get eb id)))
          (ctt-merge-loop
            (rest ids)
            ea
            eb
            (assoc
              acc
              id
              (cond
                ((= x nil) y)
                ((= y nil) x)
                (else (ctt-merge-element x y))))))))))

(define crdt-tree-merge (fn (a b) {:elements (ctt-merge-loop (crdt-union-keys (get a :elements) (get b :elements)) (get a :elements) (get b :elements) {})}))

(define
  crdt-tree-merge-all
  (fn
    (states)
    (if
      (= (len states) 0)
      (crdt-empty)
      (if
        (= (len states) 1)
        (first states)
        (crdt-tree-merge (first states) (crdt-tree-merge-all (rest states)))))))

;; ── op interpreter ──
(define
  crdt-tree-op-insert
  (fn (id type pos parent fields ts actor) {:ts ts :fields fields :parent parent :id id :type type :op "insert" :actor actor :pos pos}))

(define crdt-tree-op-update (fn (id field value ts actor) {:ts ts :field field :id id :op "update" :actor actor :value value}))

(define crdt-tree-op-delete (fn (id) {:id id :op "delete"}))

(define
  crdt-tree-apply
  (fn
    (state op)
    (let
      ((k (get op :op)))
      (cond
        ((= k "insert")
          (crdt-tree-insert
            state
            (get op :id)
            (get op :type)
            (get op :pos)
            (get op :parent)
            (get op :fields)
            (get op :ts)
            (get op :actor)))
        ((= k "update")
          (crdt-tree-update
            state
            (get op :id)
            (get op :field)
            (get op :value)
            (get op :ts)
            (get op :actor)))
        ((= k "delete") (crdt-tree-delete state (get op :id)))
        (else (error (str "unknown crdt-tree op: " k)))))))

(define
  crdt-tree-apply-all
  (fn
    (state ops)
    (if
      (= (len ops) 0)
      state
      (crdt-tree-apply-all (crdt-tree-apply state (first ops)) (rest ops)))))

;; ── materialise to a Phase-1 document (rebuild the ordered tree) ──
(define
  ctt-children
  (fn
    (state parent-id)
    (crdt-sort-by-pos
      (filter
        (fn (e) (= (get e :parent) parent-id))
        (crdt-live-elements state)))))

(define
  ctt-element->block
  (fn
    (state e)
    (if
      (= (get e :type) "section")
      (mk-section
        (get e :id)
        (map
          (fn (c) (ctt-element->block state c))
          (ctt-children state (get e :id))))
      (crdt-element->block e))))

(define
  crdt-tree-materialize
  (fn
    (doc-id state)
    (doc-new
      doc-id
      (map (fn (e) (ctt-element->block state e)) (ctt-children state "")))))

(define
  crdt-tree-order
  (fn (state) (map (fn (e) (get e :id)) (ctt-children state ""))))