crdt / lib / op.ml

(** CRDT patch operations.

    This module defines all 18 patch opcodes from json-joy with their full data
    structures, matching the json-crdt-patch specification. *)

(** {1 Core Types} *)

type timestamp = Clock.timestamp
(** A timestamp reference [sid, time] *)

type timespan = Clock.timespan
(** A timespan [sid, time, span] for delete operations *)

type obj_entry = string * timestamp
(** Object entry: key and value reference *)

(** {1 Operation Types} *)

type new_con = { con_value : Value.t }
(** Create constant node - stores a JSON primitive value. The value can be null,
    boolean, number (int/float), or string. *)

type new_val = unit
(** Create mutable value node - wrapper for a single reference. Initially points
    to nothing, set via ins_val. *)

type new_obj = unit
(** Create object node - LWW-Map of string keys to node references. *)

type new_vec = unit
(** Create vector node - fixed-size tuple with positional slots. *)

type new_str = unit
(** Create string node - RGA of UTF-16 characters. *)

type new_bin = unit
(** Create binary node - RGA of bytes. *)

type new_arr = unit
(** Create array node - RGA of node references. *)

type ins_val = {
  ins_val_obj : timestamp;  (** Target value node *)
  ins_val_value : timestamp;  (** Reference to set *)
}
(** Set value node reference.
    @param obj The value node to modify
    @param value Reference to the new value node *)

type ins_obj = {
  ins_obj_obj : timestamp;  (** Target object node *)
  ins_obj_value : obj_entry list;  (** Key-value pairs *)
}
(** Insert/update object entries.
    @param obj The object node to modify
    @param value List of (key, node_ref) pairs to set *)

type ins_vec = {
  ins_vec_obj : timestamp;  (** Target vector node *)
  ins_vec_idx : int;  (** Slot index *)
  ins_vec_value : timestamp;  (** Reference to set *)
}
(** Set vector slot.
    @param obj The vector node to modify
    @param idx Slot index (0-based)
    @param value Reference to the node to set *)

type ins_str = {
  ins_str_obj : timestamp;  (** Target string node *)
  ins_str_after : timestamp;  (** Insert after this position *)
  ins_str_value : string;  (** Text to insert *)
}
(** Insert text into string node (RGA insert).
    @param obj The string node to modify
    @param after Insert position (after this element)
    @param value Text to insert (UTF-16) *)

type ins_bin = {
  ins_bin_obj : timestamp;  (** Target binary node *)
  ins_bin_after : timestamp;  (** Insert after this position *)
  ins_bin_value : bytes;  (** Bytes to insert *)
}
(** Insert bytes into binary node (RGA insert).
    @param obj The binary node to modify
    @param after Insert position (after this element)
    @param value Bytes to insert (base64 encoded in JSON) *)

type ins_arr = {
  ins_arr_obj : timestamp;  (** Target array node *)
  ins_arr_after : timestamp;  (** Insert after this position *)
  ins_arr_value : timestamp;  (** Reference to insert *)
}
(** Insert element into array node (RGA insert).
    @param obj The array node to modify
    @param after Insert position (after this element)
    @param value Reference to node to insert *)

type upd_arr = {
  upd_arr_obj : timestamp;  (** Target array node *)
  upd_arr_pos : timestamp;  (** Position to update *)
  upd_arr_value : timestamp;  (** New reference *)
}
(** Update array element (overwrite at existing position).
    @param obj The array node to modify
    @param pos Element position to update
    @param value New reference to set *)

type del = {
  del_obj : timestamp;  (** Target node *)
  del_what : timespan list;  (** Ranges to delete *)
}
(** Delete ranges from an RGA (string, binary, or array).
    @param obj The node to delete from
    @param what List of timespans to delete *)

type nop = { nop_len : int }
(** No-op operation - used for padding/alignment.
    @param len Number of IDs consumed by this nop *)

(** {1 Operation Sum Type} *)

(** An operation with all its data *)
type op_data =
  | Op_new_con of new_con  (** Create constant *)
  | Op_new_val  (** Create value node *)
  | Op_new_obj  (** Create object node *)
  | Op_new_vec  (** Create vector node *)
  | Op_new_str  (** Create string node *)
  | Op_new_bin  (** Create binary node *)
  | Op_new_arr  (** Create array node *)
  | Op_ins_val of ins_val  (** Set value reference *)
  | Op_ins_obj of ins_obj  (** Insert object entries *)
  | Op_ins_vec of ins_vec  (** Set vector slot *)
  | Op_ins_str of ins_str  (** Insert string text *)
  | Op_ins_bin of ins_bin  (** Insert binary data *)
  | Op_ins_arr of ins_arr  (** Insert array element *)
  | Op_upd_arr of upd_arr  (** Update array element *)
  | Op_del of del  (** Delete ranges *)
  | Op_nop of nop  (** No-op *)

(** {1 Opcode Enumeration} *)

(** Operation opcodes (numeric encoding) *)
type opcode =
  | New_con  (** 0: Create constant node *)
  | New_val  (** 1: Create mutable value node *)
  | New_obj  (** 2: Create object node *)
  | New_vec  (** 3: Create vector node *)
  | New_str  (** 4: Create string node *)
  | New_bin  (** 5: Create binary node *)
  | New_arr  (** 6: Create array node *)
  | Ins_val  (** 7: Set value node reference *)
  | Ins_obj  (** 8: Insert/update object key *)
  | Ins_vec  (** 9: Set vector slot *)
  | Ins_str  (** 10: Insert text into string *)
  | Ins_bin  (** 11: Insert bytes into binary *)
  | Ins_arr  (** 12: Insert element into array *)
  | Upd_arr  (** 13: Update array element *)
  | Del  (** 14: Delete range *)
  | Nop  (** 15: No-op *)

(** Get the opcode number *)
let opcode_to_int = function
  | New_con -> 0
  | New_val -> 1
  | New_obj -> 2
  | New_vec -> 3
  | New_str -> 4
  | New_bin -> 5
  | New_arr -> 6
  | Ins_val -> 7
  | Ins_obj -> 8
  | Ins_vec -> 9
  | Ins_str -> 10
  | Ins_bin -> 11
  | Ins_arr -> 12
  | Upd_arr -> 13
  | Del -> 14
  | Nop -> 15

(** Get opcode from number *)
let int_to_opcode = function
  | 0 -> Some New_con
  | 1 -> Some New_val
  | 2 -> Some New_obj
  | 3 -> Some New_vec
  | 4 -> Some New_str
  | 5 -> Some New_bin
  | 6 -> Some New_arr
  | 7 -> Some Ins_val
  | 8 -> Some Ins_obj
  | 9 -> Some Ins_vec
  | 10 -> Some Ins_str
  | 11 -> Some Ins_bin
  | 12 -> Some Ins_arr
  | 13 -> Some Upd_arr
  | 14 -> Some Del
  | 15 -> Some Nop
  | _ -> None

(** Get the opcode of an operation *)
let opcode_of_op = function
  | Op_new_con _ -> New_con
  | Op_new_val -> New_val
  | Op_new_obj -> New_obj
  | Op_new_vec -> New_vec
  | Op_new_str -> New_str
  | Op_new_bin -> New_bin
  | Op_new_arr -> New_arr
  | Op_ins_val _ -> Ins_val
  | Op_ins_obj _ -> Ins_obj
  | Op_ins_vec _ -> Ins_vec
  | Op_ins_str _ -> Ins_str
  | Op_ins_bin _ -> Ins_bin
  | Op_ins_arr _ -> Ins_arr
  | Op_upd_arr _ -> Upd_arr
  | Op_del _ -> Del
  | Op_nop _ -> Nop

(** Get the operation name (string) *)
let opcode_name = function
  | New_con -> "new_con"
  | New_val -> "new_val"
  | New_obj -> "new_obj"
  | New_vec -> "new_vec"
  | New_str -> "new_str"
  | New_bin -> "new_bin"
  | New_arr -> "new_arr"
  | Ins_val -> "ins_val"
  | Ins_obj -> "ins_obj"
  | Ins_vec -> "ins_vec"
  | Ins_str -> "ins_str"
  | Ins_bin -> "ins_bin"
  | Ins_arr -> "ins_arr"
  | Upd_arr -> "upd_arr"
  | Del -> "del"
  | Nop -> "nop"

(** Get opcode from name *)
let opcode_of_name = function
  | "new_con" -> Some New_con
  | "new_val" -> Some New_val
  | "new_obj" -> Some New_obj
  | "new_vec" -> Some New_vec
  | "new_str" -> Some New_str
  | "new_bin" -> Some New_bin
  | "new_arr" -> Some New_arr
  | "ins_val" -> Some Ins_val
  | "ins_obj" -> Some Ins_obj
  | "ins_vec" -> Some Ins_vec
  | "ins_str" -> Some Ins_str
  | "ins_bin" -> Some Ins_bin
  | "ins_arr" -> Some Ins_arr
  | "upd_arr" -> Some Upd_arr
  | "del" -> Some Del
  | "nop" -> Some Nop
  | _ -> None

(** Get the operation name from op_data *)
let op_name op = opcode_name (opcode_of_op op)

(** {1 ID Span Calculation} *)

(** Calculate how many IDs an operation consumes. Most operations use exactly 1
    ID, but some use more:
    - new_con: 1
    - new_val/new_obj/new_vec/new_str/new_bin/new_arr: 1
    - ins_val: 1
    - ins_obj: 1 (the entries reference existing IDs)
    - ins_vec: 1
    - ins_str: length of string (UTF-16 code units)
    - ins_bin: length of bytes
    - ins_arr: 1
    - upd_arr: 1
    - del: 1
    - nop: nop_len *)
let id_span = function
  | Op_new_con _ -> 1
  | Op_new_val -> 1
  | Op_new_obj -> 1
  | Op_new_vec -> 1
  | Op_new_str -> 1
  | Op_new_bin -> 1
  | Op_new_arr -> 1
  | Op_ins_val _ -> 1
  | Op_ins_obj _ -> 1
  | Op_ins_vec _ -> 1
  | Op_ins_str { ins_str_value; _ } ->
      (* UTF-16 code units - for ASCII this equals string length *)
      String.length ins_str_value
  | Op_ins_bin { ins_bin_value; _ } -> Bytes.length ins_bin_value
  | Op_ins_arr _ -> 1
  | Op_upd_arr _ -> 1
  | Op_del _ -> 1
  | Op_nop { nop_len } -> nop_len

(** {1 Constructors} *)

(** Create a new_con operation *)
let make_new_con value = Op_new_con { con_value = value }

(** Create a new_val operation *)
let make_new_val () = Op_new_val

(** Create a new_obj operation *)
let make_new_obj () = Op_new_obj

(** Create a new_vec operation *)
let make_new_vec () = Op_new_vec

(** Create a new_str operation *)
let make_new_str () = Op_new_str

(** Create a new_bin operation *)
let make_new_bin () = Op_new_bin

(** Create a new_arr operation *)
let make_new_arr () = Op_new_arr

(** Create an ins_val operation *)
let make_ins_val ~obj ~value =
  Op_ins_val { ins_val_obj = obj; ins_val_value = value }

(** Create an ins_obj operation *)
let make_ins_obj ~obj ~entries =
  Op_ins_obj { ins_obj_obj = obj; ins_obj_value = entries }

(** Create an ins_vec operation *)
let make_ins_vec ~obj ~idx ~value =
  Op_ins_vec { ins_vec_obj = obj; ins_vec_idx = idx; ins_vec_value = value }

(** Create an ins_str operation *)
let make_ins_str ~obj ~after ~value =
  Op_ins_str { ins_str_obj = obj; ins_str_after = after; ins_str_value = value }

(** Create an ins_bin operation *)
let make_ins_bin ~obj ~after ~value =
  Op_ins_bin { ins_bin_obj = obj; ins_bin_after = after; ins_bin_value = value }

(** Create an ins_arr operation *)
let make_ins_arr ~obj ~after ~value =
  Op_ins_arr { ins_arr_obj = obj; ins_arr_after = after; ins_arr_value = value }

(** Create an upd_arr operation *)
let make_upd_arr ~obj ~pos ~value =
  Op_upd_arr { upd_arr_obj = obj; upd_arr_pos = pos; upd_arr_value = value }

(** Create a del operation *)
let make_del ~obj ~what = Op_del { del_obj = obj; del_what = what }

(** Create a nop operation *)
let make_nop len = Op_nop { nop_len = len }

(** {1 Legacy compatibility} *)

type t = { id : timestamp; op : op_data }
(** Legacy type alias - an operation with its ID *)

(** Get operation name from legacy type *)
let name { op; _ } = op_name op