crdt / lib / model_api.ml

(** High-level editing API.

    Provides a user-friendly interface for editing CRDT documents with
    path-based access, transaction support, and automatic node creation.

    Key features:
    - Path-based navigation using JSON Pointer syntax
    - Transaction support with flush/commit
    - Automatic node creation for nested structures
    - Type-safe node proxies for editing

    Usage:
    {[
      let api = Model_api.create model in

      (* Direct editing *)
      Model_api.set api "/" (Value.String "hello");

      (* String editing *)
      let str_node = Model_api.str api "/text" in
      Model_api.str_insert str_node ~pos:0 ~text:"hello";

      (* Object editing *)
      let obj_node = Model_api.obj api "/data" in
      Model_api.obj_set obj_node ~key:"name" ~value:(Value.String "Alice");

      (* Flush changes to patch *)
      let patch = Model_api.flush api
    ]} *)

(** {1 Types} *)

type t = { model : Model.t; mutable builder : Patch_builder.t }
(** An API handle for editing a model with transaction support *)

(** {1 Creation} *)

(** Create an API handle for a model *)
let create model = { model; builder = Patch_builder.create model.Model.clock }

(** Reset the transaction state, discarding any pending changes *)
let reset api = Patch_builder.reset api.builder

(** {1 Transaction Support} *)

(** Flush pending operations as a patch. Returns None if no operations. *)
let flush api = Patch_builder.flush api.builder

(** Flush and apply the patch to the model atomically. Returns the patch. *)
let commit api =
  match flush api with
  | Some patch ->
      Model.apply api.model patch;
      Some patch
  | None -> None

(** Check if there are pending operations *)
let has_pending api = Patch_builder.has_pending api.builder

(** Get the number of pending operations *)
let pending_count api = Patch_builder.pending_count api.builder

(** {1 Clock Access} *)

(** Get the current logical time *)
let current_time api = Patch_builder.current_time api.builder

(** Get the session ID *)
let session_id api = Patch_builder.session_id api.builder

(** Get the model *)
let model api = api.model

(** {1 Path Resolution} *)

(** Result of resolving a path *)
type path_result =
  | Found of Node.t  (** Found the node *)
  | Not_found  (** Path doesn't exist *)
  | Type_mismatch of string  (** Wrong node type for path segment *)

(** Resolve a JSON Pointer path to a node *)
let resolve_path api (path : string) : path_result =
  let pointer = Pointer.parse path in
  let segments = Pointer.segments pointer in
  (* Filter out empty segments (e.g., "/" parses as [""] which should be []) *)
  let segments = List.filter (fun s -> s <> "") segments in

  (* Start from root *)
  let rec walk current_node remaining =
    match remaining with
    | [] -> Found current_node
    | seg :: rest -> (
        match current_node with
        | Node.Node_val { val_ref = Some ts; _ } -> (
            (* Follow the reference *)
            match Model.get_node api.model ts with
            | Some next -> walk next (seg :: rest)
            | None -> Not_found)
        | Node.Node_val { val_ref = None; _ } -> Not_found
        | Node.Node_obj { obj_entries; _ } -> (
            (* Look up key in object *)
            match
              List.find_opt
                (fun (e : Node.obj_entry) -> e.obj_key = seg)
                obj_entries
            with
            | Some entry -> (
                match Model.get_node api.model entry.obj_value with
                | Some next -> walk next rest
                | None -> Not_found)
            | None -> Not_found)
        | Node.Node_vec { vec_slots; _ } -> (
            (* Parse index and look up slot *)
            match int_of_string_opt seg with
            | Some idx -> (
                match
                  List.find_opt
                    (fun (s : Node.vec_slot) -> s.vec_idx = idx)
                    vec_slots
                with
                | Some slot -> (
                    match Model.get_node api.model slot.vec_value with
                    | Some next -> walk next rest
                    | None -> Not_found)
                | None -> Not_found)
            | None -> Type_mismatch "vec requires numeric index")
        | Node.Node_arr _ -> Type_mismatch "arr traversal not supported"
        | Node.Node_str _ -> Type_mismatch "str has no children"
        | Node.Node_bin _ -> Type_mismatch "bin has no children"
        | Node.Node_con _ -> Type_mismatch "con has no children")
  in
  walk api.model.root segments

(** {1 Node Access} *)

(** Get a node at a path, or None if not found *)
let get api path =
  match resolve_path api path with Found node -> Some node | _ -> None

(** Get the value at a path *)
let get_value api path =
  match get api path with Some node -> Some (Node.view node) | None -> None

(** Get the fully resolved value at a path *)
let view api path =
  match resolve_path api path with
  | Found node -> Some (Model.view_node api.model node)
  | _ -> None

(** {1 Internal Helpers} *)

(** Get the next ID that will be assigned (before adding an op) *)
let next_id api : Clock.timestamp = Patch_builder.next_op_id api.builder

(** Add a new_con operation and return the ID that will be assigned *)
let add_const api value =
  let id = next_id api in
  Patch_builder.new_con api.builder value;
  id

(** Set the document root to a value *)
let set_root api value =
  let const_id = add_const api value in
  Patch_builder.ins_val api.builder ~obj:Model.root_id ~value:const_id

(** {1 Object Operations} *)

type obj_proxy = { obj_api : t; obj_id : Clock.timestamp }
(** Object proxy for editing *)

(** Get or create an object at a path. For an existing object, returns a proxy
    to edit it. For an unset val node, creates a new object and returns its
    proxy. The object won't exist in the model until commit is called. *)
let obj api path : obj_proxy option =
  match resolve_path api path with
  | Found (Node.Node_obj { obj_id; _ }) -> Some { obj_api = api; obj_id }
  | Found (Node.Node_val { val_ref = None; val_id; _ }) ->
      (* Create new object and set the val to point to it *)
      let id = next_id api in
      Patch_builder.new_obj api.builder;
      Patch_builder.ins_val api.builder ~obj:val_id ~value:id;
      Some { obj_api = api; obj_id = id }
  | _ -> None

(** Set a key in an object proxy. Returns the timestamp of the new value node.
*)
let obj_set proxy ~key ~value =
  (* Create a const node for the value *)
  let const_id = add_const proxy.obj_api value in
  (* Insert into object *)
  Patch_builder.ins_obj proxy.obj_api.builder ~obj:proxy.obj_id
    ~entries:[ (key, const_id) ];
  const_id

(** Delete a key from an object. This sets the key to undefined. *)
let obj_delete proxy ~key =
  let undef_id = add_const proxy.obj_api Value.Undefined in
  Patch_builder.ins_obj proxy.obj_api.builder ~obj:proxy.obj_id
    ~entries:[ (key, undef_id) ]

(** Get a value from the object (only works after commit) *)
let obj_get proxy ~key =
  match Model.get_node proxy.obj_api.model proxy.obj_id with
  | Some (Node.Node_obj { obj_entries; _ }) -> (
      match
        List.find_opt (fun (e : Node.obj_entry) -> e.obj_key = key) obj_entries
      with
      | Some entry -> Model.get_node proxy.obj_api.model entry.obj_value
      | None -> None)
  | _ -> None

(** Get all keys in the object (only works after commit) *)
let obj_keys proxy =
  match Model.get_node proxy.obj_api.model proxy.obj_id with
  | Some (Node.Node_obj { obj_entries; _ }) ->
      List.map (fun (e : Node.obj_entry) -> e.obj_key) obj_entries
  | _ -> []

(** {1 String Operations} *)

type str_proxy = {
  str_api : t;
  str_id : Clock.timestamp;
  mutable last_insert_end : Clock.timestamp option;
      (** End of last inserted text *)
}
(** String proxy for editing. Tracks the last insert position for sequential
    appends. *)

(** Get or create a string at a path *)
let str api path : str_proxy option =
  match resolve_path api path with
  | Found (Node.Node_str { str_id; _ }) ->
      Some { str_api = api; str_id; last_insert_end = None }
  | Found (Node.Node_val { val_ref = None; val_id; _ }) ->
      (* Create new string and set the val to point to it *)
      let id = next_id api in
      Patch_builder.new_str api.builder;
      Patch_builder.ins_val api.builder ~obj:val_id ~value:id;
      Some { str_api = api; str_id = id; last_insert_end = None }
  | _ -> None

(** Insert text at a position in a string.
    @param pos Character position (0 = start)
    @param text Text to insert *)
let str_insert proxy ~pos ~text =
  let insert_id = next_id proxy.str_api in
  let text_len = String.length text in
  match Model.get_node proxy.str_api.model proxy.str_id with
  | Some (Node.Node_str { str_rga; _ }) ->
      let after =
        match Rga.find_position_string str_rga pos with
        | Some ts -> ts
        | None -> proxy.str_id (* Insert at head = after node ID *)
      in
      Patch_builder.ins_str proxy.str_api.builder ~obj:proxy.str_id ~after
        ~value:text;
      (* Track end of this insert *)
      proxy.last_insert_end <-
        Some { insert_id with time = insert_id.time + text_len - 1 }
  | _ ->
      (* Node doesn't exist yet - insert at head *)
      Patch_builder.ins_str proxy.str_api.builder ~obj:proxy.str_id
        ~after:proxy.str_id ~value:text;
      proxy.last_insert_end <-
        Some { insert_id with time = insert_id.time + text_len - 1 }

(** Append text to a string *)
let str_append proxy ~text =
  let insert_id = next_id proxy.str_api in
  let text_len = String.length text in
  (* First check if we have a pending insert to chain after *)
  let after =
    match proxy.last_insert_end with
    | Some end_id -> end_id (* Chain after previous insert *)
    | None -> (
        (* No pending insert - check the actual RGA *)
        match Model.get_node proxy.str_api.model proxy.str_id with
        | Some (Node.Node_str { str_rga; _ }) -> (
            match Rga.find_last_id str_rga with
            | Some ts -> ts
            | None -> proxy.str_id)
        | _ -> proxy.str_id (* Node doesn't exist yet *))
  in
  Patch_builder.ins_str proxy.str_api.builder ~obj:proxy.str_id ~after
    ~value:text;
  proxy.last_insert_end <-
    Some { insert_id with time = insert_id.time + text_len - 1 }

(** Delete text from a string.
    @param pos Start position
    @param len Number of characters to delete *)
let str_delete proxy ~pos ~len =
  match Model.get_node proxy.str_api.model proxy.str_id with
  | Some (Node.Node_str { str_rga; _ }) ->
      let spans = Rga.find_spans_string str_rga ~pos ~len in
      if spans <> [] then
        Patch_builder.del proxy.str_api.builder ~obj:proxy.str_id ~what:spans
  | _ -> ()

(** Get the current string value (only works after commit or for existing
    strings) *)
let str_value proxy =
  match Model.get_node proxy.str_api.model proxy.str_id with
  | Some (Node.Node_str { str_rga; _ }) -> Rga.view_string str_rga
  | _ -> ""

(** Get the string length *)
let str_length proxy =
  match Model.get_node proxy.str_api.model proxy.str_id with
  | Some (Node.Node_str { str_rga; _ }) -> Rga.visible_length str_rga
  | _ -> 0

(** {1 Array Operations} *)

type arr_proxy = { arr_api : t; arr_id : Clock.timestamp }
(** Array proxy for editing *)

(** Get or create an array at a path *)
let arr api path : arr_proxy option =
  match resolve_path api path with
  | Found (Node.Node_arr { arr_id; _ }) -> Some { arr_api = api; arr_id }
  | Found (Node.Node_val { val_ref = None; val_id; _ }) ->
      let id = next_id api in
      Patch_builder.new_arr api.builder;
      Patch_builder.ins_val api.builder ~obj:val_id ~value:id;
      Some { arr_api = api; arr_id = id }
  | _ -> None

(** Insert an element at a position in an array.
    @param pos Array index (0 = start)
    @param value Value to insert *)
let arr_insert proxy ~pos ~value =
  let const_id = add_const proxy.arr_api value in
  match Model.get_node proxy.arr_api.model proxy.arr_id with
  | Some (Node.Node_arr { arr_rga; _ }) ->
      let after =
        match Rga.find_position_arr arr_rga pos with
        | Some ts -> ts
        | None -> proxy.arr_id (* Insert at head *)
      in
      Patch_builder.ins_arr proxy.arr_api.builder ~obj:proxy.arr_id ~after
        ~value:const_id
  | _ ->
      Patch_builder.ins_arr proxy.arr_api.builder ~obj:proxy.arr_id
        ~after:proxy.arr_id ~value:const_id

(** Append an element to an array *)
let arr_push proxy ~value =
  let const_id = add_const proxy.arr_api value in
  match Model.get_node proxy.arr_api.model proxy.arr_id with
  | Some (Node.Node_arr { arr_rga; _ }) ->
      let after =
        match Rga.find_last_id arr_rga with
        | Some ts -> ts
        | None -> proxy.arr_id (* Empty = insert at head *)
      in
      Patch_builder.ins_arr proxy.arr_api.builder ~obj:proxy.arr_id ~after
        ~value:const_id
  | _ ->
      Patch_builder.ins_arr proxy.arr_api.builder ~obj:proxy.arr_id
        ~after:proxy.arr_id ~value:const_id

(** Delete elements from an array.
    @param pos Start position
    @param count Number of elements to delete *)
let arr_delete proxy ~pos ~count =
  match Model.get_node proxy.arr_api.model proxy.arr_id with
  | Some (Node.Node_arr { arr_rga; _ }) ->
      let spans = Rga.find_spans_arr arr_rga ~pos ~len:count in
      if spans <> [] then
        Patch_builder.del proxy.arr_api.builder ~obj:proxy.arr_id ~what:spans
  | _ -> ()

(** Get the current array length *)
let arr_length proxy =
  match Model.get_node proxy.arr_api.model proxy.arr_id with
  | Some (Node.Node_arr { arr_rga; _ }) -> Rga.visible_length arr_rga
  | _ -> 0

(** {1 Binary Operations} *)

type bin_proxy = { bin_api : t; bin_id : Clock.timestamp }
(** Binary proxy for editing *)

(** Get or create a binary blob at a path *)
let bin api path : bin_proxy option =
  match resolve_path api path with
  | Found (Node.Node_bin { bin_id; _ }) -> Some { bin_api = api; bin_id }
  | Found (Node.Node_val { val_ref = None; val_id; _ }) ->
      let id = next_id api in
      Patch_builder.new_bin api.builder;
      Patch_builder.ins_val api.builder ~obj:val_id ~value:id;
      Some { bin_api = api; bin_id = id }
  | _ -> None

(** Insert bytes at a position *)
let bin_insert proxy ~pos ~data =
  match Model.get_node proxy.bin_api.model proxy.bin_id with
  | Some (Node.Node_bin { bin_rga; _ }) ->
      let after =
        match Rga.find_position_bytes bin_rga pos with
        | Some ts -> ts
        | None -> proxy.bin_id (* Insert at head *)
      in
      Patch_builder.ins_bin proxy.bin_api.builder ~obj:proxy.bin_id ~after
        ~value:data
  | _ ->
      Patch_builder.ins_bin proxy.bin_api.builder ~obj:proxy.bin_id
        ~after:proxy.bin_id ~value:data

(** Append bytes *)
let bin_append proxy ~data =
  match Model.get_node proxy.bin_api.model proxy.bin_id with
  | Some (Node.Node_bin { bin_rga; _ }) ->
      let after =
        match Rga.find_last_id bin_rga with
        | Some ts -> ts
        | None -> proxy.bin_id (* Empty = insert at head *)
      in
      Patch_builder.ins_bin proxy.bin_api.builder ~obj:proxy.bin_id ~after
        ~value:data
  | _ ->
      Patch_builder.ins_bin proxy.bin_api.builder ~obj:proxy.bin_id
        ~after:proxy.bin_id ~value:data

(** Delete bytes from binary.
    @param pos Start position
    @param len Number of bytes to delete *)
let bin_delete proxy ~pos ~len =
  match Model.get_node proxy.bin_api.model proxy.bin_id with
  | Some (Node.Node_bin { bin_rga; _ }) ->
      let spans = Rga.find_spans_bytes bin_rga ~pos ~len in
      if spans <> [] then
        Patch_builder.del proxy.bin_api.builder ~obj:proxy.bin_id ~what:spans
  | _ -> ()

(** Get the current binary value *)
let bin_value proxy =
  match Model.get_node proxy.bin_api.model proxy.bin_id with
  | Some (Node.Node_bin { bin_rga; _ }) -> Rga.view_bytes bin_rga
  | _ -> Bytes.empty

(** Get the binary length *)
let bin_length proxy =
  match Model.get_node proxy.bin_api.model proxy.bin_id with
  | Some (Node.Node_bin { bin_rga; _ }) -> Rga.visible_length bin_rga
  | _ -> 0

(** {1 Vector Operations} *)

type vec_proxy = { vec_api : t; vec_id : Clock.timestamp }
(** Vector proxy for editing *)

(** Get or create a vector at a path *)
let vec api path : vec_proxy option =
  match resolve_path api path with
  | Found (Node.Node_vec { vec_id; _ }) -> Some { vec_api = api; vec_id }
  | Found (Node.Node_val { val_ref = None; val_id; _ }) ->
      let id = next_id api in
      Patch_builder.new_vec api.builder;
      Patch_builder.ins_val api.builder ~obj:val_id ~value:id;
      Some { vec_api = api; vec_id = id }
  | _ -> None

(** Set a slot in a vector (0-255) *)
let vec_set proxy ~idx ~value =
  if idx < 0 || idx > 255 then invalid_arg "vec_set: idx out of range";
  let const_id = add_const proxy.vec_api value in
  Patch_builder.ins_vec proxy.vec_api.builder ~obj:proxy.vec_id ~idx
    ~value:const_id

(** Get a slot value from the vector *)
let vec_get proxy ~idx =
  match Model.get_node proxy.vec_api.model proxy.vec_id with
  | Some (Node.Node_vec { vec_slots; _ }) -> (
      match
        List.find_opt (fun (s : Node.vec_slot) -> s.vec_idx = idx) vec_slots
      with
      | Some slot -> Model.get_node proxy.vec_api.model slot.vec_value
      | None -> None)
  | _ -> None

(** {1 Document View} *)

(** Get the complete document view *)
let view_document api = Model.view api.model

(** Pretty print the document *)
let pp_document fmt api =
  let value = Model.view api.model in
  Value.pp fmt value